Hi Everyone,
I am attempting to use a macro to batch save all of the drawings in a folder as PDFs. The goal is to save the PDF using a file name built on configuration specific custom properties. Right now I'm having trouble getting the file names to build properly in all cases.
I started with code taken from this post, () and slightly modified for my needs. In Matt Jones' words, the macro is meant to
"
-Open a Folder Selection Box (where the user selects a folder)
-Open all the drawing files in the selected folder (one by one, one after the other)
-Check to see if there is a folder called "PDF" in the directory, if not then create one
-Save the open drawing file as a pdf, building the save as name from custom properties in the referenced model
-Close the drawing
-Move on to next one
"
My file name string is supposed to look like this, where italics are custom properties, sometimes configuration specific custom properties.
"Number - Description Rev-Revision.pdf"
What ends up happening, is that for some of the files the custom properties are returned as blank, so I end up saving over one PDF named " - Rev-.PDF".
Some of my files work though, and it ends up saving them properly like "3534-001 - MOTOR BRACKET BOTTOM PLATE REV-A.PDF".
And even still some others save as "3534-001 - MOTOR BRACKET BOTTOM PLATE REV-.PDF" which works except for the empty revision.
I think the problem is tied to files with or without custom configurations. It seems that the ones with custom configurations work rather well except for the revision, but those that are weldments or without custom configurations don't work at all.
Here is my code, and the macro file is also attached if that's useful
Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim sFileName As String
Dim vFileName As String
Dim Path As String
Dim nPath As String
Dim nErrors As Long
Dim nWarnings As Long
Dim swDraw As SldWorks.DrawingDoc
Dim swCustProp As CustomPropertyManager
Dim swView As SldWorks.View
Dim ConfigName As String
Dim i As Long
Dim valOut1 As String
Dim valOut2 As String
Dim valOut3 As String
Dim resolvedValOut1 As String
Dim resolvedValOut2 As String
Dim resolvedValOut3 As String
Dim PartNo As String
Dim nFileName As String
Dim swDocs As Variant
Dim PDFpath As String
Dim currpath As String
Dim PartNoDes As String
Sub main()
Set swApp = Application.SldWorks
'added by Deepak's suggestion
Dim swExportPDFData As SldWorks.ExportPdfData
Set swExportPDFData = swApp.GetExportFileData(1)
swExportPDFData.ViewPdfAfterSaving = False
Path = BrowseFolder() '"Select a Path/Folder"
Path = Path + "\"
'moved from below
PDFpath = Path & "PDF"
If Dir(PDFpath, vbDirectory) = "" Then MkDir PDFpath
sFileName = Dir(Path & "*.slddrw")
Do Until sFileName = ""
Set swModel = swApp.OpenDoc6(Path + sFileName, swDocDRAWING, swOpenDocOptions_Silent, "", nErrors, nWarnings)
Set swModel = swApp.ActiveDoc
Set swDraw = swApp.ActiveDoc
Set swView = swDraw.GetFirstView
Set swView = swView.GetNextView
Set swModel = swView.ReferencedDocument
If swModel.GetType = swDocPART Then
' PartNoDes = Mid(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\") + 1)
' PartNoDes = Right(PartNoDes, Len(PartNoDes) - 14)
' PartNoDes = Left(PartNoDes, Len(PartNoDes) - 7)
' PartNo = Mid(swModel.GetPathName, InStrRev(swModel.GetPathName, "\") + 1)
' PartNo = Left(PartNo, Len(PartNo) - 7)
If ((swView.ReferencedConfiguration <> "Default") Or (swView.ReferencedConfiguration <> "Default
") _ Or (swView.ReferencedConfiguration <> "Default
")) Then Set swCustProp = swModel.Extension.CustomPropertyManager(swView.ReferencedConfiguration)
Else
Set swCustProp = swModel.Extension.CustomPropertyManager("")
End If
ConfigName = swView.ReferencedConfiguration
swCustProp.Get2 "Number", valOut1, resolvedValOut1
swCustProp.Get2 "Description", valOut2, resolvedValOut2
swCustProp.Get2 "Revision", valOut3, resolvedValOut3
nFileName = PDFpath & "\" & resolvedValOut1 & " - " & resolvedValOut2 & " REV-" & resolvedValOut3
swDraw.SaveAs3 nFileName & ".PDF", 0, 0
ElseIf swModel.GetType = swDocASSEMBLY Then
' PartNoDes = Mid(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\") + 1)
' PartNoDes = Right(PartNoDes, Len(PartNoDes) - 11)
' PartNoDes = Left(PartNoDes, Len(PartNoDes) - 7)
' PartNo = Mid(swModel.GetPathName, InStrRev(swModel.GetPathName, "\") + 1)
' PartNo = Left(PartNo, Len(PartNo) - 7)
If (swView.ReferencedConfiguration <> "Default") Then
Set swCustProp = swModel.Extension.CustomPropertyManager(swView.ReferencedConfiguration)
Else
Set swCustProp = swModel.Extension.CustomPropertyManager("")
End If
ConfigName = swView.ReferencedConfiguration
' swCustProp.Get2 "Number", valOut1, resolvedValOut1
' swCustProp.Get2 "Description", valOut2, resolvedValOut2
' swCustProp.Get2 "Revision", valOut3, resolvedValOut3
' nFileName = PDFpath & "\" & resolvedValOut1 & " - " & resolvedValOut2 & " REV-" & resolvedValOut3
swDraw.SaveAs3 nFileName & ".PDF", 0, 0
End If
swApp.QuitDoc swDraw.GetPathName
Set swDraw = Nothing
Set swModel = Nothing
sFileName = Dir
Loop
MsgBox "All Done"
End Sub
Function BrowseFolder(Optional Title As String, Optional TopFolder _
As String) As String
Dim objShell As New Shell32.Shell
Dim objFolder As Shell32.Folder
'If you use 16384 instead of 1 on the next line,
'files are also displayed
Set objFolder = objShell.BrowseforFolder(0, Title, 1, TopFolder)
If Not objFolder Is Nothing Then
BrowseFolder = objFolder.Items.Item.Path
End If
End Function
Message was edited by: Quentin TorgersonTried to make code appear as VBA syntax, having trouble
SolidworksApi macros