Help Batch Saving Drawings As PDF - Configuration Specific Properties in File Name

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