PDF Macro with Revision Info

[wsf2012]

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!

 

[TheTick]

Getting to the model from the drawing takes a few twists and turns. You need to get one of the drawing views first, and then get the model from the drawing view.

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.

 

[wsf2012]

Hi "TheTick", I've just kindly been given the answer by Deepak Gupta, for anyone else needing the code:


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