AnsweredAssumed Answered

PDF Macro with Revision Info

Question asked by Will Frost on Dec 2, 2014
Latest reply on Dec 2, 2014 by Will Frost

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!

Outcomes