Save as PDF Macro

[SPerman]

I have a macro that I run on drawings. It gets the properties of the parent model and adds that info to the file name before saving it as a PDF. This works great if the parent model is a part. If it is an assembly, it does not get the custom properties.

There is a similar post on the other site without any resolution.
https://r1132100503382-eu1-3dswym.3dexp ... PsojEvtMIw

Code: Select all

Dim Part As Object
Dim longstatus As Long
Dim swApp           As SldWorks.SldWorks
Dim swModel         As SldWorks.ModelDoc2
Dim swDraw          As SldWorks.DrawingDoc
Dim swView          As SldWorks.View
Dim swModelDocExt   As ModelDocExtension
Dim swCustPropMgr   As CustomPropertyManager
Dim sModelName      As String
Dim sModelPath      As String
Dim sNewPath        As String
Dim sNewName        As String
Dim sModelFullName  As String
Dim CropPos         As Integer
Dim sRev            As String
Dim sDesc           As String
Dim Bool            As Boolean
Dim Junk            As String

Sub main()

Set swApp = Application.SldWorks
Set swDraw = swApp.ActiveDoc
Set swView = swDraw.GetFirstView 'this gets the sheet
Set swView = swView.GetNextView 'this gets the first view

'Set Part = swApp.ActiveDoc
Set swModel = swView.ReferencedDocument
Set swModelDocExt = swModel.Extension
Set swCustPropMgr = swModel.Extension.CustomPropertyManager("")

'this is the full name and path
sModelPath = swModel.GetPathName

'get filename from full path
CropPos = InStrRev(sModelPath, "\")
sNewName = Right(sModelPath, (Len(sModelPath) - CropPos))

'strip slddrw extension
sNewName = Left(sNewName, Len(sNewName) - 7)

'add revision and description
Set swCustProp = swModelDocExt.CustomPropertyManager("")
Bool = swCustProp.Get4("Revision", False, sRev, Junk)
Bool = swCustProp.Get4("Long Name", False, sDesc, Junk)
sNewName = sNewName + "-" + sRev + "-" + sDesc
sNewName = StripOut(sNewName, ",")

'add pdf extension
sNewName = sNewName + ".pdf"

'get path
sNewPath = Left(sModelPath, CropPos - 1)

'remove subdirectory from path
CropPos = InStrRev(sNewPath, "\")
sNewPath = Left(sNewPath, CropPos)

'add drawings folder
sNewPath = sNewPath + "drawings\"

sModelFullName = sNewPath + sNewName

' Save As

longstatus = swDraw.SaveAs3(sModelFullName, 0, 2)


End Sub

[zwei]

Maybe a dumb question...
Do you have Revision and Long Name in your assembly custom property?
Is the first view in your drawing the assembly?
I did a quick scan on your macro and it dont seem to have any issue and should work even if in assembly...

[gupta9665]

The macro should work with any model type. I made a slight change in the codes

Code: Select all

Dim longstatus      As Long
Dim swApp           As SldWorks.SldWorks
Dim swModel         As SldWorks.ModelDoc2
Dim swDraw          As SldWorks.DrawingDoc
Dim swView          As SldWorks.View
Dim swModelDocExt   As ModelDocExtension
Dim swCustPropMgr   As CustomPropertyManager
Dim sModelName      As String
Dim sModelPath      As String
Dim sNewPath        As String
Dim sNewName        As String
Dim sModelFullName  As String
Dim CropPos         As Integer
Dim sRev            As String
Dim sDesc           As String
Dim Bool            As Boolean
Dim Junk            As String

Sub main()

Set swApp = Application.SldWorks
Set swDraw = swApp.ActiveDoc

Set swView = swDraw.GetFirstView 'this gets the sheet
Set swView = swView.GetNextView 'this gets the first view

Set swModel = swView.ReferencedDocument
Set swModelDocExt = swModel.Extension
Set swCustPropMgr = swModel.Extension.CustomPropertyManager("")

Bool = swCustPropMgr.Get4("Revision", False, sRev, Junk)
Bool = swCustPropMgr.Get4("Long Name", False, sDesc, Junk)

'this is the full name and path
sModelPath = swModel.GetPathName

'get filename from full path
CropPos = InStrRev(sModelPath, "\")
sNewName = Right(sModelPath, (Len(sModelPath) - CropPos))

'strip slddrw extension
sNewName = Left(sNewName, Len(sNewName) - 7)

'add revision and description
sNewName = sNewName + "-" + sRev + "-" + sDesc
sNewName = Replace(sNewName, ",", "")

'add pdf extension
sNewName = sNewName + ".pdf"

'get path
sNewPath = Left(sModelPath, CropPos - 1)

'remove subdirectory from path
CropPos = InStrRev(sNewPath, "\")
sNewPath = Left(sNewPath, CropPos)

'add drawings folder
sNewPath = sNewPath + "drawings\"

sModelFullName = sNewPath + sNewName

' Save As
longstatus = swDraw.SaveAs3(sModelFullName, 0, 2)


End Sub

[SPerman]

Thanks for your help.

I figured out my problem. The custom properties in the assembly were configuration specific.