Editing PDF/DWG-STEP Macro Code

Hi all

I use a basic macro to save my drawings in PDF/DWG that I got from the internet. I would like to make it evolve on 2 points:

  • Store PDFs in a PDF subfolder and the same for DWGs, in my Drawing folder
  • I would like to be able to open the part of my drawing and create STEP which will be saved in a subfolder of my parts folder.

I'm new to SW macros and I'm a bit lost, if anyone can help me

Here's the code:

Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Dim FeatureData As Object
Dim Feature As Object
Dim Component As Object

Sub main()
Set swApp = Application.SldWorks

Set Part = swApp.ActiveDoc
Path = Part.GetPathName 'Chemin du fichier

'Enregistrement PDF
Part.SaveAs2 Left(Path, (Len(Path) - 6)) & "PDF", 0, True, False '

'Enregistrement DWG
Part.SaveAs2 Left(Path, (Len(Path) - 6)) & "DWG", 0, True, False '

MsgBox " Enregistrement réussi", vbInformation

Set Part = Nothing

End Sub

For an equivalent topic (dwg-pdf and step) see this one: the macro of @Cyril.f is functional:

The only thing to change if you're happy with it will be the addition of folders. (Pdf, Dwg, Step)
̈There are several methods to do this, but you need to know:
1-If your filename has the same number of characters or not, to be able to retrieve the folder name.
And for the step here only step on part if assembly it won't work.

Then to manipulate your filename, folder:

' PathName of current model document
Dim sModelFullPath As String
sModelFullPath = swModel.GetPathName

' get path name without filename
Dim sFilePath As String
sFilePath = Left(sModelFullPath, InStrRev(sModelFullPath, "\"))

' get filename and extension
Dim sFileName As String
sFileName = Right(sModelFullPath, Len(sModelFullPath) - InStrRev(sModelFullPath, "\"))

' get filename without extension
Dim sFileNameWithoutExtension As String
sFileNameWithoutExtension = Left(sFileName, InStrRev(sFileName, ".") - 1)

' combine everything to new path name
Dim sNewFullPath As String
sNewFullPath = prefix & sFileNameWithoutExtension & "REV" & CurrRev & ".pdf"

' SaveAs with new full path
Set swExportPDFData = swApp.GetExportFileData(1)
swModel.Extension.SaveAs sNewFullPath, 0, 0, swExportPDFData, 0, 0

1 Like

Thank you for this feedback, I tested the code but it doesn't work on my PC, I have a message that tells me that I have an undefined block on line 118.

As for the files, they do not have the same number of characters, they are made up as follows:
XXXX-XXXX-XXX-XXX - Designation

Concerning the steps I am only looking to do room drawings.

If I understand the following code correctly, is it to add the path for saving files of the different formats?

Probably the clue (Revision) that he can't find.
And with this code:

Option Explicit

Public Enum swDocumentTypes_e
    swDocNONE = 0       ' Used to be TYPE_NONE

    swDocPART = 1       ' Used to be TYPE_PART

    swDocASSEMBLY = 2   ' Used to be TYPE_ASSEMBLY

    swDocDRAWING = 3    ' Used to be TYPE_DRAWING
End Enum
 
Dim swApp                       As SldWorks.SldWorks
Dim swModel                     As SldWorks.ModelDoc2
Dim swDraw                      As SldWorks.DrawingDoc
Dim swView                      As SldWorks.View
Dim swConfig                    As SldWorks.Configuration

Dim vSheetNameArr               As Variant
Dim vSheetName                  As Variant

Dim I                           As Long
Dim nDocType                    As Long
Dim op                          As Long
Dim suppr                       As Long
Dim lErrors                     As Long
Dim lWarnings                   As Long

Dim boolstatus                  As Boolean
Dim bRet                        As Boolean
Dim FileConnu                   As Boolean

Dim nbConnu                     As Integer

Dim sModelName                  As String
Dim sPathName                   As String
Dim TabConnu(10000)             As String
Dim sConfigName                 As String
Dim sModelFullPath              As String
Dim sFilePath                   As String
Dim sFileName                   As String
Dim sFileNameWithoutExtension   As String

Sub main()



Set swApp = Application.SldWorks
boolstatus = swApp.SetUserPreferenceIntegerValue(swStepAP, 214) 'Force la version AP214
boolstatus = swApp.SetUserPreferenceIntegerValue(swStepExportPreference, swAcisOutputGeometryPreference_e.swAcisOutputAsSolidAndSurface) 'Force l'export en format Solid/Surface Geometry

Set swModel = swApp.ActiveDoc

' PathName of current model document
sModelFullPath = swModel.GetPathName

' get path name without filename
sFilePath = Left(sModelFullPath, InStrRev(sModelFullPath, "\"))

' get filename and extension
sFileName = Right(sModelFullPath, Len(sModelFullPath) - InStrRev(sModelFullPath, "\"))

' get filename without extension
sFileNameWithoutExtension = Left(sFileName, InStrRev(sFileName, ".") - 1)



Debug.Print sFilePath & "Pdf\" & sFileNameWithoutExtension & ".pdf"
'On vérifie si le dossier de sauvegarde existe sinon création de ce dossier
If Dir(sFilePath & "Pdf\", vbDirectory) = vbNullString Then
    MkDir sFilePath & "Pdf\"
End If
swModel.Extension.SaveAs sFilePath & "Pdf\" & sFileNameWithoutExtension & ".pdf", swSaveAsCurrentVersion, swSaveAsOptions_Silent, Nothing, lErrors, lWarnings
'On vérifie si le dossier de sauvegarde existe sinon création de ce dossier
If Dir(sFilePath & "Dwg\", vbDirectory) = vbNullString Then
    MkDir sFilePath & "Dwg\"
End If
swModel.Extension.SaveAs sFilePath & "Dwg\" & sFileNameWithoutExtension & ".dwg", swSaveAsCurrentVersion, swSaveAsOptions_Silent, Nothing, lErrors, lWarnings
'On vérifie si le dossier de sauvegarde existe sinon création de ce dossier
If Dir(sFilePath & "Step\", vbDirectory) = vbNullString Then
    MkDir sFilePath & "Step\"
End If
Call ExportStep

End Sub
Sub ExportStep()
Set swDraw = swModel
vSheetName = swDraw.GetSheetNames
vSheetNameArr = swDraw.GetSheetNames

For Each vSheetName In vSheetNameArr
        
    bRet = swDraw.ActivateSheet(vSheetName): Debug.Assert bRet
    Set swView = swDraw.GetFirstView 'Sélectionne le fond de plan
    Set swView = swView.GetNextView  'Passe à la vue suivante pour exclure le fond de plan
                
    While Not swView Is Nothing
           
        ' Determine if this is a view of a part or assembly

        sModelName = swView.GetReferencedModelName

        sModelName = LCase(sModelName)
                        
        sConfigName = swView.ReferencedConfiguration
        
        FileConnu = False
        
        If InStr(sModelName, "sldprt") > 0 Then
            nDocType = swDocPART
        ElseIf InStr(sModelName, "slasm") > 0 Then
            nDocType = swDocASSEMBLY
        Else
            nDocType = swDocNONE
            Exit Sub
        End If
                       
        If nDocType = 1 Then
            For I = 1 To nbConnu
                If UCase(sModelName) & " - " & UCase(sConfigName) = TabConnu(I) Then
                    FileConnu = True
                End If
            Next
            If Not FileConnu Then
                nbConnu = nbConnu + 1
                TabConnu(nbConnu) = UCase(sModelName) & " - " & UCase(sConfigName)
                Call Export
            End If
        End If
        
        Set swView = swView.GetNextView
    Wend

Next vSheetName



End Sub
Sub Export()
Set swModel = swApp.ActivateDoc3(sModelName, True, swOpenDocOptions_Silent, lErrors)
Set swModel = swApp.ActiveDoc
boolstatus = swModel.ShowConfiguration2(sConfigName)
Set swConfig = swModel.GetActiveConfiguration
sPathName = sFilePath & "Step\" & sFileNameWithoutExtension & ".step"
'sPathName = swModel.GetPathName & ".step"
If Dir(sPathName, vbHidden) <> "" Then              'Test l'existence du fichier
    suppr = MsgBox("Le fichier " & sPathName & " existe déjà, voulez vous le supprimer?", vbYesNo) 'Message utilisateur confirmation de suppression oui/non
        If suppr = vbYes Then                       'Réponse Oui
            Kill (sPathName) 'Suppression du fichier existant
            swModel.SaveAs2 sPathName, 0, True, False  'Enregistrement du fichier
            op = MsgBox("Le fichier a été enregistré sous " & sPathName & vbNewLine)
            Else                                    'Réponse NON
        MsgBox ("Fichier conservé")                 'Message utilisateur
        End If
        Else
        swModel.SaveAs2 sPathName, 0, True, False      'Enregistrement du fichier
        op = MsgBox("Le fichier a été enregistré sous " & sPathName) 'Message utilisateur
    End If
swApp.CloseDoc (sModelName)
Set swModel = swApp.ActiveDoc
End Sub

1 Like

I just tested it but I still get the same message

Are you launching the macro from a drawing?

1 Like

Yes I created a basic drawing of a sheet metal part

Did you record it as well? (if not registered can't find the name)

1 Like

Yes, it is well recorded!
it works with my little macro I can do PDF/DWG

Do the drawings and the rooms have the same name? (excluding extensions)

1 Like

If you are in version < or = to 2020 you can also attach a plan + part if you want.
I don't reproduce the problem.

2 Likes

Yes, because when I save the drawing, it does take up the name of the room!
Here are the files (I'm in 2022 version)
TMS-64300-003-PDM - Cap.SLDDRW (183.1 KB)
TMS-64300-003-PDM - Cap.SLDPRT (111.7 KB)

If I can, I'll open a PC with the 2023 to test, but not possible for now.
See if you delete call ExportStep already if the pdf and the dwg are well done to start with.

1 Like

It's okay I have the PDF and the DWG in the same file as the SW plan. Indeed by removing the ExportStep call it works

I tested on SW2023 the 3 files are exported to my home.
So it doesn't come from the file name. Are your files local or on networks?
No special characters in your file path?
Try by copying to C:\Temp\YourFiles for example to see if it works
image
image

2 Likes

Okay I just have PDF/DWG

the files are on networks and no there are no special characters in the path

The ExportStep call must be put back.
And test on the C drive with a simple path to see.

1 Like

I did the test by putting it on my desk and it didn't work and the same on the C I have the same message as at the beginning.

I admit that I am lost...

I'm drying too! :crazy_face:
Can you edit the macro, add the Execution and Local Variables windows (see image), then click just after Sub main() and press F8 just so that it bugs?
image

Basically, lacerate the macro step by step. And check in the local variable window the value of sModelName when it crashes:


And also if swModel remains empty.

1 Like