Stephane Morvan

Macro to Export to PDF will only run once... Solidworks restart required?!?

Discussion created by Stephane Morvan on Apr 16, 2020
Latest reply on Apr 20, 2020 by Stephane Morvan

So I edited this Macro in October, from pieces and bits that I got here. Basically, this is what this Macro does, probably inefficiently:

1. Saves the current drawing to disk.

2. Exports all sheets to .pdf in the ../PDF directory (above the directory which contains the current drawing)

3. Shows the PDF

 

For some reason, it now only works once. On all subsequent runs, it displays an Error, with a code 1. I can't think of a settings that I have changed recently that would cause that. If I restart Solidworks, I can run it only once. I have done the obvious and restart the machine and all.

 

When running the Macro in the editor, it is only the last bit that fails... All the paths are computed correctly.

 

Here is the Macro:

 

Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swModelDocExt As SldWorks.ModelDocExtension
Dim swExportData As SldWorks.ExportPdfData
Dim boolstatus As Boolean
Dim filename As String
Dim lErrors As Long
Dim lWarnings As Long
Dim pdfDir As String
Dim baseDir As String
Dim FSO


Sub main()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
If swModel Is Nothing Then
MsgBox "No current document", vbCritical
End
End If
If swModel.GetType <> swDocDRAWING Then
MsgBox "This Macro only works on Drawings", vbCritical
End
End If
Set swModelDocExt = swModel.Extension
Set swExportData = swApp.GetExportFileData(swExportPdfData)
filename = swModel.GetPathName
Set FSO = CreateObject("Scripting.FileSystemObject")
If filename = "" Then
MsgBox "Please save the file first and try again", vbCritical
End
End If

'Save drawing
boolstatus = swExportData.SetSheets(swExportData_ExportAllSheets, 1)
boolstatus = swModelDocExt.SaveAs(filename, 0, 0, swExportData, lErrors, lWarnings)
If boolstatus Then
'MsgBox "Save as Drawing successful" & vbNewLine & filename
Else
MsgBox "Save as Drawing failed, Error code:" & lErrors
End If


'Save as PDF
'Get Root Directory of Part
pdfDir = Left(swModel.GetPathName, InStrRev(swModel.GetPathName, "\") - 1)
pdfDir = Right(pdfDir, Len(pdfDir) - InStrRev(pdfDir, "\"))
pdfDir = Left(swModel.GetPathName, InStrRev(swModel.GetPathName, "\") - Len(pdfDir) - 1) + "pdf\"
filename = swModel.GetPathName
filename = Right(filename, Len(filename) - InStrRev(filename, "\"))
filename = Left(filename, Len(filename) - 6) & "pdf"
filename = pdfDir & filename

boolstatus = swExportData.SetSheets(swExportData_ExportAllSheets, 1)
swExportData.ViewPdfAfterSaving = True
boolstatus = swModelDocExt.SaveAs(filename, 0, 0, swExportData, lErrors, lWarnings)
If boolstatus Then
'MsgBox "Save as PDF successful" & vbNewLine & filename
Else
MsgBox "Save as PDF failed, Error code:" & lErrors
End If


End Sub

 

Any hint on what would cause this behaviour?

 

TIA!

 

Stephane

Outcomes