Save as PDF example code 2

[fcsuper]

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.

 

[AnnaWood]

fcsuper,

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

http://www.auerprecision.com

 

[tmalinski]

I can't get this to work with SW2007, I get an error.."Cannot open C:\Program Files\SolidWorks 2007\Macros\SaveAsPDF.swp"

Is swp the wrong extension to apply to this macro?

Tom Malinski
Sr Design Engineer
OKay Industries
New Britain CT

 

[smcadman]

What I always do whenever a macro is posted here is:
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

 

[handleman]

This works fine for me. You don't have to go through those extra steps of recording a macro. Just go to Tools->Macro->New, delete the 3 or 4 lines it puts automatically, and paste the code from here.

As far as this macro goes, how does it not work? Error messages? Which line? Or does the file just not show up?

 

[tmalinski]

handleman, thanks for the tip on how to do this, but I did it and the macro seems to run but I can't find the file if it created one
Tom...

Tom Malinski
Sr Design Engineer
OKay Industries
New Britain CT

 

[handleman]

Do you get the message box that says:

Save [filename].PDF to
[Path]
(No notification will occur
for success PDF creation.)

?

 

[fcsuper]

If the macro is working, a notification window should pop up, stating the save location, then when you click ok, either a "Creating PDF" progress bar window will pop up, or an error message window.

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

 

[fcsuper]

LOL, I copied it directly from my macro and forgot to remove the byline, so let's just say you can remove my name from the inputbox. I have that there for internal visibility purposes at my company. This macro is really a combination of functions this purpose that I've found on this message and comp.cad.solidworks, involving input from many different people.