PDF Macro with Revision Info
PDF Macro with Revision Info
(OP)
Hi I'm using the below code to try and generate a pdf from a drawing that includes revision information. The code currently pulls this from the "custom properties" in the drawings properties, but need to change this so it's pulled from the custom properties of the Part file, can anyone advise how this is done?
Code:
Dim SwApp As SldWorks.SldWorks
Dim Model As SldWorks.ModelDoc2
Dim MyPath, ModName, NewName As String
Dim MB As Boolean
Dim Errs As Long
Dim Warnings As Long
Dim reesolvedValOut As String
Dim revTag As String
Dim swConfigMgr As SldWorks.ConfigurationManager
Dim swConfig As SldWorks.Configuration
Dim swCustPropMgr As SldWorks.CustomPropertyManager
Sub main()
Set SwApp = Application.SldWorks
' This ensures that there are files loaded in SolidWorks
Set Model = SwApp.ActiveDoc
Set swConfigMgr = Model.ConfigurationManager
Set swConfig = swConfigMgr.ActiveConfiguration
If Model Is Nothing Then
MB = MsgBox("No drawing loaded!", vbCritical)
Exit Sub
End
End If
'Get Revision Tag
Set swCustPropMgr = Model.Extension.CustomPropertyManager("")
swCustPropMgr.Get2 "Revision", revTag, reesolvedValOut
' Admonish user if attempted to run macro on part or assy file
If Model.GetType <> 3 Then
SwApp.SendMsgToUser "Current document is not a drawing."
End
End If
' 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)
' Status
ModName = Left(Model.GetTitle, InStrRev(Model.GetTitle, " Sheet") - 3)
NewName = ModName & " REV " & revTag & ".pdf"
MsgBox "Save file:" & Chr(13) & NewName & Chr(13) & Chr(13) & "To location:" & Chr(13) & MyPath & Chr(13) & Chr(13) & "No notification will occur for success PDF creation."
' PDF Creation
MB = Model.SaveAs4(MyPath & "\" & 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 save location, available" & Chr(13) & "disk space or other possible causes.", vbCritical
Else
End If
'Clear immediate values
Set Model = Nothing
Set MyPath = Nothing
End Sub
Many thanks for the help!
Code:
Dim SwApp As SldWorks.SldWorks
Dim Model As SldWorks.ModelDoc2
Dim MyPath, ModName, NewName As String
Dim MB As Boolean
Dim Errs As Long
Dim Warnings As Long
Dim reesolvedValOut As String
Dim revTag As String
Dim swConfigMgr As SldWorks.ConfigurationManager
Dim swConfig As SldWorks.Configuration
Dim swCustPropMgr As SldWorks.CustomPropertyManager
Sub main()
Set SwApp = Application.SldWorks
' This ensures that there are files loaded in SolidWorks
Set Model = SwApp.ActiveDoc
Set swConfigMgr = Model.ConfigurationManager
Set swConfig = swConfigMgr.ActiveConfiguration
If Model Is Nothing Then
MB = MsgBox("No drawing loaded!", vbCritical)
Exit Sub
End
End If
'Get Revision Tag
Set swCustPropMgr = Model.Extension.CustomPropertyManager("")
swCustPropMgr.Get2 "Revision", revTag, reesolvedValOut
' Admonish user if attempted to run macro on part or assy file
If Model.GetType <> 3 Then
SwApp.SendMsgToUser "Current document is not a drawing."
End
End If
' 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)
' Status
ModName = Left(Model.GetTitle, InStrRev(Model.GetTitle, " Sheet") - 3)
NewName = ModName & " REV " & revTag & ".pdf"
MsgBox "Save file:" & Chr(13) & NewName & Chr(13) & Chr(13) & "To location:" & Chr(13) & MyPath & Chr(13) & Chr(13) & "No notification will occur for success PDF creation."
' PDF Creation
MB = Model.SaveAs4(MyPath & "\" & 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 save location, available" & Chr(13) & "disk space or other possible causes.", vbCritical
Else
End If
'Clear immediate values
Set Model = Nothing
Set MyPath = Nothing
End Sub
Many thanks for the help!






RE: PDF Macro with Revision Info
This all works simply enough if you have only one part or assembly per drawing (like the vast majority of drawings out there). If you have multi-part drawings, you need to take steps to ensure you are grabbing the right view.
RE: PDF Macro with Revision Info
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swDraw As SldWorks.DrawingDoc
Dim swCustProp As CustomPropertyManager
Dim valOut As String
Dim resolvedValOut As String
Dim Filepath As String
Dim FileName As String
Dim ConfigName As String
Sub main()
Set swApp = Application.SldWorks
Set swDraw = swApp.ActiveDoc
' Check to see if a drawing is loaded.
If (swDraw Is Nothing) Or (swDraw.GetType <> swDocDRAWING) Then
swApp.SendMsgToUser ("To be used for drawings only, Open a drawing first and then TRY!")
' If no model currently loaded, then exit
Exit Sub
End If
Set swView = swDraw.GetFirstView
Set swView = swView.GetNextView
Set swModel = swView.ReferencedDocument
ConfigName = swView.ReferencedConfiguration
Set swCustProp = swModel.Extension.CustomPropertyManager(Revision)
swCustProp.Get2 "Revision", valOut, resolvedValOut 'Change the custom property name here
Filepath = Left(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\"))
FileName = Left(swDraw.GetTitle, Len(swDraw.GetTitle) - 9)
swDraw.SaveAs (Filepath + FileName + " REV " + resolvedValOut + ".PDF") 'Change the custom property text here
MsgBox "Drawing:" & Chr(13) & FileName & ".SLDDRW" & Chr(13) & Chr(13) & "With Revision:" & Chr(13) & resolvedValOut & Chr(13) & Chr(13) & "Saved as file:" & Chr(13) & FileName + " REV " + resolvedValOut + ".PDF" & Chr(13) & Chr(13) & "To location:" & Chr(13) & Filepath
End Sub