Hi all,

I've tried so hard to mod macros I already have rather than bug you lot but just can't work it out:

I have the below existing macro from Deepak that successfully exports and names PDF and DXF from a drawing with set names. What I need is to have a macro that exports a full drawing to PDF and then sets the filename as: "Drawing Filename (windows filename)"_"REVISION" (revision within drawing) - "PART NUMBER (custom property in part/assembly)".

The part I'm struggling with is calling custom properties from the drawing AND the part to make the filename I want, mainly because I don't know how.  My modified macro is below Deepak's original. When I replace the "PROFILE ORDER CODE" and "PROFILE NAME" properties with those located within the drawing document I just get blanks in the filename, I assume because the macro is set up to look for part properties, not drawing? I'm also going from a name string of 2x properties to 3x properties, and not sure how to call in the 3rd.

Original:

Option Explicit
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swDrawModel As SldWorks.ModelDoc2
Dim swDraw As SldWorks.DrawingDoc
Dim swCustPropMgr As CustomPropertyManager
Dim swView As SldWorks.View
Dim swExportPDFData As SldWorks.ExportPdfData
Dim sFileName As String
Dim ValOut As String
Dim ResolvedValOut(1) As String
Dim wasResolved As Boolean
Dim nErrors As Long
Dim nWarnings As Long

Set swApp = Application.SldWorks
Set swDrawModel = swApp.ActiveDoc

' Check to see if a drawing is loaded.
If swDrawModel Is Nothing Then
MsgBox "There is no active drawing document"
Exit Sub
End If

If swDrawModel.GetType <> swDocDRAWING Then
MsgBox "Open a drawing first and then TRY again!"
Exit Sub
End If

If swDrawModel.GetPathName = "" Then
MsgBox "Save the drawing first and then TRY again!"
Exit Sub
End If

Set swDraw = swDrawModel
Set swView = swDraw.GetFirstView
Set swView = swView.GetNextView

' Determine if there is any view
If swView Is Nothing Then
MsgBox "Insert a View first and then TRY again!"
Exit Sub
End If

Set swModel = swView.ReferencedDocument
Set swCustPropMgr = swModel.Extension.CustomPropertyManager(swView.ReferencedConfiguration)
swCustPropMgr.Get5 "PROFILE ORDER CODE", False, ValOut, ResolvedValOut(0), wasResolved
swCustPropMgr.Get5 "PROFILE NAME", False, ValOut, ResolvedValOut(1), wasResolved

'Get and set file name
sFileName = Left(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\")) & ResolvedValOut(0) & " - " & ResolvedValOut(1)
Set swExportPDFData = swApp.GetExportFileData(1)
swExportPDFData.SetSheets swExportData_ExportCurrentSheet, ""
swExportPDFData.ViewPdfAfterSaving = False

swApp.SetUserPreferenceIntegerValue swUserPreferenceIntegerValue_e.swDxfMultiSheetOption, swDxfActiveSheetOnly

'Save as DXF
swDraw.Extension.SaveAs sFileName & ".DXF", 0, 0, Nothing, nErrors, nWarnings

'Save as PDF
swDraw.Extension.SaveAs sFileName & ".PDF", 0, 0, swExportPDFData, nErrors, nWarnings

End Sub

Modified:

Option Explicit
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swDrawModel As SldWorks.ModelDoc2
Dim swDraw As SldWorks.DrawingDoc
Dim swCustPropMgr As CustomPropertyManager
Dim swView As SldWorks.View
Dim swExportPDFData As SldWorks.ExportPdfData
Dim sFileName As String
Dim ValOut As String
Dim ResolvedValOut(1) As String
Dim wasResolved As Boolean
Dim nErrors As Long
Dim nWarnings As Long

Set swApp = Application.SldWorks
Set swDrawModel = swApp.ActiveDoc

' Check to see if a drawing is loaded.
If swDrawModel Is Nothing Then
MsgBox "There is no active drawing document"
Exit Sub
End If

If swDrawModel.GetType <> swDocDRAWING Then
MsgBox "Open a drawing first and then TRY again!"
Exit Sub
End If

If swDrawModel.GetPathName = "" Then
MsgBox "Save the drawing first and then TRY again!"
Exit Sub
End If

Set swDraw = swDrawModel
Set swView = swDraw.GetFirstView
Set swView = swView.GetNextView

' Determine if there is any view
If swView Is Nothing Then
MsgBox "Insert a View first and then TRY again!"
Exit Sub
End If

Set swModel = swView.ReferencedDocument
Set swCustPropMgr = swModel.Extension.CustomPropertyManager(swView.ReferencedConfiguration)
swCustPropMgr.Get5 "SW-FILE NAME", False, ValOut, ResolvedValOut(0), wasResolved
swCustPropMgr.Get5 "REVISION", False, ValOut, ResolvedValOut(1), wasResolved

'Get and set file name
sFileName = Left(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\")) & ResolvedValOut(0) & " - " & ResolvedValOut(1)
Set swExportPDFData = swApp.GetExportFileData(1)
'***DEACTIVATED*** swExportPDFData.SetSheets swExportData_ExportCurrentSheet, ""
swExportPDFData.ViewPdfAfterSaving = True

'***DEACTIVATED*** swApp.SetUserPreferenceIntegerValue swUserPreferenceIntegerValue_e.swDxfMultiSheetOption, swDxfActiveSheetOnly

'Save as DXF
'***DEACTIVATED*** swDraw.Extension.SaveAs sFileName & ".DXF", 0, 0, Nothing, nErrors, nWarnings

'Save as PDF
swDraw.Extension.SaveAs sFileName & ".PDF", 0, 0, swExportPDFData, nErrors, nWarnings

End Sub

Thanks in advance!