Help with a Save as PDF Macro

Hi all,

I am trying to program macro to save my current drawing as a PDF
file. I found a macro on the net that does this and it works great.
However, I wanted to modify it to add the drawing revision to the file
name. I know others have attempted the same thing, but I can't seem
to get the code to run.

I would appreciate it if some who knows better could review the code
and find my mistake. The trouble seems to be in the way I am trying
to get the value for the revision parameter from the drawing. Iv'e
tried lots of aproaches, but it seems I am not getting the correct
object.

Much appreciated.

Dave Seebauer

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, 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 = swConfig.CustomPropertyManager
Set void = 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 & " R" & revTag & ".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
' 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

 

Try replacing...
Set swConfigMgr = Model.ConfigurationManager
Set swConfig = swConfigMgr.ActiveConfiguration


With...
Set swCustPropMgr = Model.Extension.CustomPropertyManager("")
swCustPropMgr.Get2 "Revision", revTag, reesolvedValOut


Derek

 

Try replacing...
Set swCustPropMgr = swConfig.CustomPropertyManager
Set void = swCustPropMgr.Get2("Revision", revTag, reesolvedValOut)


With...
Set swCustPropMgr = Model.Extension.CustomPropertyManager("")
swCustPropMgr.Get2 "Revision", revTag, reesolvedValOut

 

Awesome! Only other thing I had to do was explicitly define the
"reesolvedValOut" variable as a String. The way I had it it, it I
guess it assumes it as variant.

I had tried to use the ModelDocExtension object directly, but I
couldn't nail down the path you provided.

Works like a charm.

Thanks Derek!

 

evodesign,

Did your maco have a header with authorship and reference link to
where it was from, or did you find this on a forum somewhere? It was
pulled togetherfrom several sources a year or so ago as part of a
discussion on eng-tips.com; and your version looks a littled
outdated. Here's an updated version:
http://sw.fcsuper.com/index.php?name=UpDownload&req=viewdownloaddetails&lid=3.
You should be able to make your edit to that macro same as the older
version you are currently using.

Matt
http://sw.fcsuper.com