AnsweredAssumed Answered

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

Question asked by Quentin Torgerson on Apr 28, 2017
Latest reply on Jun 20, 2017 by Deepak Gupta

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, (Macro Help: Open All Drawings In Folder and Save As PDF) 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<As Machined>") _
                    Or (swView.ReferencedConfiguration <> "Default<As Welded>")) 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 Torgerson Tried to make code appear as VBA syntax, having trouble

Outcomes