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?
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
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)
'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."
' 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)
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
If MB = False Then
MsgBox "PDF creation has failed! Check save location, available" & Chr(13) & "disk space or other possible causes.", vbCritical
'Clear immediate values
Set Model = Nothing
Set MyPath = Nothing
Many thanks for the help!