Save as PDF example code
Save as PDF example code
(OP)
From several posts on this board and comp.cad.solidworks message boards, I've put together the following example of a macro that will save the current solidworks doc (part/assy/dwg) as a PDF. Since I recently updated it, I figured I might as well share (since I got it from here anyway). I've left remarks in to offer alternatives for several functions. Changes from previous posted versions of this macro include nondrawing support and more error handling. Of course, suggestions for improvement are always welcome. :)
Dim SwApp As SldWorks.SldWorks
Dim Model As SldWorks.ModelDoc2
Dim MyPath, ModName, NewName As String
Dim fso As Object
Dim MB As Boolean
Dim Errs As Long
Dim Warnings As Long
Sub main()
Set SwApp = Application.SldWorks
Set Model = SwApp.ActiveDoc
' Error handler for no document loaded
If Model Is Nothing Then MsgBox "No drawing loaded!", vbCritical: End
' Use one of the three following options for PDF save location. Comment out the options with are not used.
' Option 1: Use the current directory
' MyPath = CurDir
' Option 2: Specify the directory you want to use
MyPath = "C:\PDF"
' Option 3: Use the document's folder
' MyPath = Left(Model.GetPathName, InStrRev(Model.GetPathName, "\") - 1)
' Determine if directory exists
Set fso = CreateObject("Scripting.FileSystemObject")
If (Not fso.FolderExists(MyPath)) Then MsgBox (MyPath + " does not exist!"), vbCritical: End
' Call correct sub
If Model.GetType <> 3 Then Call notdrawing
Call ifdrawing
End Sub
Sub notdrawing()
ModName = Left(Model.GetTitle, InStrRev(Model.GetTitle, ".") - 1)
Call alldoc
End Sub
Sub ifdrawing()
' Status
ModName = Left(Model.GetTitle, InStrRev(Model.GetTitle, " Sheet") - 3)
Call alldoc
End Sub
Sub alldoc()
NewName = ModName & ".pdf"
MsgBox "Save " & NewName & " to" & Chr(13) & MyPath & Chr(13) & Chr(13) & "(No notification will occur " & Chr(13) & "for success PDF creation.)"
' PDF Creation
MB = Model.SaveAs4(MyPath & "\" & NewName, swSaveAsCurrentVersion, swSaveAsOptions_Silent, Errs, Warnings)
' Warnings to user on Error
If Warnings <> 0 Then
MsgBox "There were warnings. PDF creation may have failed. Verify" & Chr(13) & "results and check possible causes.", vbExclamation
Else
End If
If MB = False Then
MsgBox "PDF creation has failed! Check save location, available" & Chr(13) & "disk space or other possible causes.", vbCritical
Else
End If
Call last
End Sub
Sub last()
' Clear immediate values
Set Model = Nothing
Set MyPath = Nothing
End
End Sub
Please note that this code assumes Save as PDF function is available. In S/W versions of 2005 or under, you will need to goto Add-In's to active the "Save As PDF" Add-in. 2006 and above do not have this issue.
Dim SwApp As SldWorks.SldWorks
Dim Model As SldWorks.ModelDoc2
Dim MyPath, ModName, NewName As String
Dim fso As Object
Dim MB As Boolean
Dim Errs As Long
Dim Warnings As Long
Sub main()
Set SwApp = Application.SldWorks
Set Model = SwApp.ActiveDoc
' Error handler for no document loaded
If Model Is Nothing Then MsgBox "No drawing loaded!", vbCritical: End
' Use one of the three following options for PDF save location. Comment out the options with are not used.
' Option 1: Use the current directory
' MyPath = CurDir
' Option 2: Specify the directory you want to use
MyPath = "C:\PDF"
' Option 3: Use the document's folder
' MyPath = Left(Model.GetPathName, InStrRev(Model.GetPathName, "\") - 1)
' Determine if directory exists
Set fso = CreateObject("Scripting.FileSystemObject")
If (Not fso.FolderExists(MyPath)) Then MsgBox (MyPath + " does not exist!"), vbCritical: End
' Call correct sub
If Model.GetType <> 3 Then Call notdrawing
Call ifdrawing
End Sub
Sub notdrawing()
ModName = Left(Model.GetTitle, InStrRev(Model.GetTitle, ".") - 1)
Call alldoc
End Sub
Sub ifdrawing()
' Status
ModName = Left(Model.GetTitle, InStrRev(Model.GetTitle, " Sheet") - 3)
Call alldoc
End Sub
Sub alldoc()
NewName = ModName & ".pdf"
MsgBox "Save " & NewName & " to" & Chr(13) & MyPath & Chr(13) & Chr(13) & "(No notification will occur " & Chr(13) & "for success PDF creation.)"
' PDF Creation
MB = Model.SaveAs4(MyPath & "\" & NewName, swSaveAsCurrentVersion, swSaveAsOptions_Silent, Errs, Warnings)
' Warnings to user on Error
If Warnings <> 0 Then
MsgBox "There were warnings. PDF creation may have failed. Verify" & Chr(13) & "results and check possible causes.", vbExclamation
Else
End If
If MB = False Then
MsgBox "PDF creation has failed! Check save location, available" & Chr(13) & "disk space or other possible causes.", vbCritical
Else
End If
Call last
End Sub
Sub last()
' Clear immediate values
Set Model = Nothing
Set MyPath = Nothing
End
End Sub
Please note that this code assumes Save as PDF function is available. In S/W versions of 2005 or under, you will need to goto Add-In's to active the "Save As PDF" Add-in. 2006 and above do not have this issue.






RE: Save as PDF example code
Thanks a bunch, this will be a handy macro to have.
Regards,
Anna Wood
SW06 SP4.1 x64, WinXP x64
Dell Precision 380, Pentium D940, 4 Gigs RAM, FX3450
www.auerprecision.com
RE: Save as PDF example code
Is swp the wrong extension to apply to this macro?
Tom Malinski
Sr Design Engineer
OKay Industries
New Britain CT
RE: Save as PDF example code
1. On the macro toolbar, hit record.
2. Zoom in or whatever.
3. Stop the macro, and save to folder.
I then hit the Edit Macro button on the macro toolbar, and then delete what I recorded, and then copy and paste whatever is posted here on Eng-tips.
This has never failed before, but I can't get this macro to work. I tried commenting out the different file save locations, etc. and I still can't get it to work. Any ideas?
Flores
SW06 SP4.1
RE: Save as PDF example code
As far as this macro goes, how does it not work? Error messages? Which line? Or does the file just not show up?
RE: Save as PDF example code
Tom...
Tom Malinski
Sr Design Engineer
OKay Industries
New Britain CT
RE: Save as PDF example code
Save [filename].PDF to
[Path]
(No notification will occur
for success PDF creation.)
?
RE: Save as PDF example code
If nothing happens when you run the macro, or you get a debug/end break error, then you may need to attach the necessary reference libraries to the macro. On some systems for some reason or another, S/W doesn't automatically attach all the needed ref libraries to new macros. (The reasons given by my VAR don't really jive with my experience on the matter.)
Anyway, as soon as I posted that code I got to thinking, "Hey, I know what to do to make it better." funny how that works. So here's an improved version with better error checking and the option for the user to change the save path. (if you are already having issues with the previous code, you will likely have the same issues with this, as all of my changes are superfacial...the hard of all this code is SolidWorks own function to save as pdf, which of course is managed by solidworks.)
Dim SwApp As SldWorks.SldWorks
Dim Model As SldWorks.ModelDoc2
Dim MyPath, ModName, NewName As String
Dim dPathName As String
Dim MyPathConf As String
Dim fso As Object
Dim MB As Boolean
Dim Errs As Long
Dim Warnings As Long
Sub main()
Set SwApp = Application.SldWorks
Set Model = SwApp.ActiveDoc
' Error handler for no document loaded
If Model Is Nothing Then MsgBox "No document loaded!", vbCritical: End
' Use one of the three following options for PDF save location
' Comment out the options with are not used.
' Option 1: Use the current directory
' MyPath = CurDir
' Option 2: Specify the directory you want to use
MyPath = "C:\PDF"
' Option 3: Use the drawing folder
' MyPath = Left(Model.GetPathName, InStrRev(Model.GetPathName, "\") - 1)
' Call correct sub
If Model.GetType <> 3 Then Call notdrawing
Call ifdrawing
End Sub
Sub notdrawing()
' Get documnet save path
dPathName = Model.GetPathName()
' Error handler if no save path
If ("" = dPathName) Then MsgBox ("This document has not been saved yet"), vbCritical: End
' Set PDF file name
ModName = Left(Model.GetTitle, InStrRev(Model.GetTitle, ".") - 1)
Call alldoc
End Sub
Sub ifdrawing()
' Set PDF file name
ModName = Left(Model.GetTitle, InStrRev(Model.GetTitle, " Sheet") - 3)
Call alldoc
End Sub
Sub alldoc()
' See PDF file name with extention .pdf
NewName = ModName & ".pdf"
' Get path and user confirmation
MyPathConf = InputBox("By Matthew Lorono" & Chr(13) & Chr(13) & "No notification will occur for " & Chr(13) & "success PDF creation." & Chr(13) & Chr(13) & "Save " & NewName & " to:", "Confirm PDF Save Path", MyPath)
If MyPathConf = "" Then MsgBox "Save As PDF cancelled by user.", vbInformation: End
' Determine if directory exists
Set fso = CreateObject("Scripting.FileSystemObject")
If (Not fso.FolderExists(MyPathConf)) Then MsgBox (MyPathConf + " does not exist!"), vbCritical: End
' PDF Creation
MB = Model.SaveAs4(MyPathConf & "\" & NewName, swSaveAsCurrentVersion, swSaveAsOptions_Silent, Errs, Warnings)
' Warnings to user on Error
' MsgBox "Errors: " & Errs & vbCrLf & "Warnings: " & Warnings
If Warnings <> 0 Then
MsgBox "There were warnings. PDF creation may have failed. Verify" & Chr(13) & "results and check possible causes.", vbExclamation
Else
End If
If MB = False Then
MsgBox "PDF creation has failed! Check Add-ins (if S/W 2005 or older)," & Chr(13) & "available disk space or other possible causes.", vbCritical
Else
End If
Call last
End Sub
Sub last()
' Clear immediate values
Set Model = Nothing
Set MyPath = Nothing
End
End Sub
RE: Save as PDF example code