AnsweredAssumed Answered

Macro Question - Batch Save PDFs

Question asked by Mike Libbey on Jun 30, 2014
Latest reply on Mar 22, 2015 by Deepak Gupta

The macro is to open all drawings for the active assembly (sub-assemblies and parts) and save them as individual PDFs.  However, the macro doesn't work.  Here is the code (which needs to run on a SW 2014, 64-bit system):

 

Any help would be greatly appreciated!

 

Thanks!

------------------------------------------------------------------------------

' Description:

' Traverses the open assembly and activates all components and their drawings (if of the

' same name).

 

Sub ShowAllOpenFiles()

Dim swDoc As SldWorks.ModelDoc2

Dim swAllDocs As EnumDocuments2

Dim FirstDoc As SldWorks.ModelDoc2

Dim dummy As Boolean

Dim NumDocsReturned As Long

Dim DocCount As Long

Dim i As Long

Dim sMsg As String

Dim swApp As SldWorks.SldWorks

Dim bDocWasVisible As Boolean

Dim OpenWarnings As Long

Dim OpenErrors As Long

Dim DwgPath As String

Dim myDwgDoc As SldWorks.ModelDoc2

Dim drwPathName As String

Dim pdfPathName As String

Dim pdfFolderName As String

 

Set swApp = Application.SldWorks

Set swAllDocs = swApp.EnumDocuments2

Set FirstDoc = swApp.ActiveDoc

   

DocCount = 0

swAllDocs.Reset

swAllDocs.Next 1, swDoc, NumDocsReturned

While NumDocsReturned <> 0

    bDocWasVisible = swDoc.Visible

    'swApp.ActivateDoc swDoc.GetPathName'

    DwgPath = swDoc.GetPathName

    If (LCase(Right(DwgPath, 3)) <> "drw") And (DwgPath <> "") Then

        DwgPath = Left(DwgPath, Len(DwgPath) - 3) & "drw"

        Set myDwgDoc = swApp.OpenDoc6(DwgPath, swDocDRAWING, swOpenDocOptions_Silent, "", OpenErrors, OpenWarnings)

        If Not myDwgDoc Is Nothing Then

            swApp.ActivateDoc myDwgDoc.GetPathName

 

pdfFolderName = "C:\pdf files\"

 

Dim fso As Scripting.FileSystemObject

Set fso = CreateObject("Scripting.FileSystemObject")

 

If (Not fso.FolderExists(pdfFolderName)) Then

MsgBox (pdfFolderName + " does not exist")

Exit Sub

End If

 

Dim Part As ModelDoc2

Set Part = swApp.ActiveDoc()

 

'You have a drawing active

drwPathName = Part.GetPathName()

 

If ("" = drwPathName) Then

' GetPathName() was empty

MsgBox ("This drawing has not been saved yet")

Exit Sub

End If

 

pdfPathName = fso.BuildPath(pdfFolderName, fso.GetBaseName(drwPathName) + ".pdf")

 

Part.SaveAs2 pdfPathName, 0, True, False

 

'MsgBox ("PDF file was created")

    swApp.QuitDoc (Part.GetTitle)

            Set myDwgDoc = Nothing

        End If

    End If

    swAllDocs.Next 1, swDoc, NumDocsReturned

    DocCount = DocCount + 1

Wend

 

swApp.ActivateDoc FirstDoc.GetPathName

 

End Sub

Outcomes