2 Replies Latest reply on May 2, 2018 2:44 AM by Mark Reina

    Export PDFs and DXFs based on a drawing sheet name

    Mark Reina

      Hi there,

      I've been trying to put together a macro by copying and pasting bits of code from other posted macros however I am unable to get the bits and pieces I needed to create the functionality I am after. I'm wondering if I can get some help here to create the correct macro.

       

      1. Check if a drawing is open, if not then say 'please open a drawing'

      2. Set save name and save path as the same as the drawing.

      3. Check if the drawing has a drawing sheet with the name containing the word "flat" exists

           If yes,

           - export the "flat" named sheet as a DXF

           - export all other sheets as a single PDF (all sheets minus "flat" sheet)

       

           If no,

           - export all sheets as a single PDF

       

      Much appreciated if I can get some help on this as I simply don't know how to code, I only understand the basic principles of it.

        • Re: Export PDFs and DXFs based on a drawing sheet name
          Ivana Kolin
          Option Explicit
          Dim swApp As SldWorks.SldWorks
          Dim swMod As SldWorks.ModelDoc2
          Dim swDraw As SldWorks.DrawingDoc
          Dim boolstatus As Boolean
          Dim warnings As Long
          Dim errors As Long
          Sub main()
              Dim vSheetNames As Variant
              Dim i As Integer
              Dim sheetName As String
              Dim fileName As String
              Dim pathName As String
              Dim swExportPDFData As SldWorks.ExportPdfData
              Set swApp = Application.SldWorks
              Set swExportPDFData = swApp.GetExportFileData(1)
              Set swMod = swApp.ActiveDoc
              If swMod Is Nothing Then
                  MsgBox "Open drawing"
                  Exit Sub
              End If
              If swMod.GetType <> swDocDRAWING Then
                  MsgBox "Open drawing"
                  Exit Sub
              End If
              fileName = swMod.GetPathName
              If fileName = "" Then
                  MsgBox "Save drawing"
                  Exit Sub
              End If
              pathName = StripFilename(fileName)
              Set swDraw = swMod
              vSheetNames = swDraw.GetSheetNames
              For i = 0 To UBound(vSheetNames)
                  sheetName = vSheetNames(i)
                  If LCase(sheetName) Like "*flat*" Then
                      swDraw.ActivateSheet sheetName
                      swMod.Extension.SaveAs pathName & sheetName & ".dxf", 0, swSaveAsOptions_e.swSaveAsOptions_Silent, Nothing, errors, warnings
                  Else
                      boolstatus = swExportPDFData.SetSheets(swExportData_ExportSpecifiedSheets, sheetName)
                      swExportPDFData.ViewPdfAfterSaving = False
                      boolstatus = swMod.Extension.SaveAs(pathName & sheetName & ".pdf", 0, 0, swExportPDFData, errors, warnings)
                  End If
              Next i
          End Sub
          Function StripFilename(sPathFile As String) As String
              Dim filesystem As Object
              Set filesystem = CreateObject("Scripting.FilesystemObject")
              StripFilename = filesystem.GetParentFolderName(sPathFile) & "\"
          End Function
          
            • Re: Export PDFs and DXFs based on a drawing sheet name
              Mark Reina

              Thank you for your time Ivana. Couple things after testing the functionality:

              - The macro is saving name as the sheet name, would like to name PDF and DXF as file name of drawing.

              - The macro is saving the PDF out as a separate PDF for each sheet, would like the PDFs saved out as a single PDF.

              Additional functionality that would be helpful

              - If a PDF or DXF already exists in the save folder, would like a prompt to change the save name to something else

               

               

              I've managed to adjust the code enough to save as the filename and also check if an existing file is present. I am still unable to make the pdf save as a single file though if I can get some help with that. My code is now as follows:

               

              Option Explicit
              Dim swApp As SldWorks.SldWorks
              Dim swMod As SldWorks.ModelDoc2
              Dim swDraw As SldWorks.DrawingDoc
              Dim boolstatus As Boolean
              Dim warnings As Long
              Dim errors As Long
              
              
              Sub main()
                  Dim vSheetNames As Variant
                  Dim i As Integer
                  Dim sheetName As String
                  Dim fileName As String
                  Dim pathName As String
                  Dim swExportPDFData As SldWorks.ExportPdfData
                  Set swApp = Application.SldWorks
                  Set swExportPDFData = swApp.GetExportFileData(1)
                  Set swMod = swApp.ActiveDoc
                  
                  If swMod Is Nothing Then
                      MsgBox "Open drawing"
                      Exit Sub
                  End If
                  If swMod.GetType <> swDocDRAWING Then
                      MsgBox "Open drawing"
                      Exit Sub
                  End If
                  fileName = swMod.GetPathName
                  If fileName = "" Then
                      MsgBox "To be used for drawings only, Open a drawing first and then TRY!"
                      Exit Sub
                  End If
                  
                  Dim fso As New Scripting.FileSystemObject
                  If fso.FileExists(StripFilename(fileName) & ".dxf") Then
                  MsgBox ("DXF already exists in folder. Move, rename or delete existing DXF then TRY!")
                  Exit Sub
                  End If
              
              
                  If fso.FileExists(StripFilename(fileName) & ".pdf") Then
                  MsgBox ("PDF already exists in folder. Move, rename or delete existing PDF then TRY!")
                  Exit Sub
                  End If
              
              
                  Set swDraw = swMod
                  vSheetNames = swDraw.GetSheetNames
                  For i = 0 To UBound(vSheetNames)
                      sheetName = vSheetNames(i)
                      If LCase(sheetName) Like "*flat*" Then
                          swDraw.ActivateSheet sheetName
                          swMod.Extension.SaveAs StripFilename(fileName) & ".dxf", 0, swSaveAsOptions_e.swSaveAsOptions_Silent, Nothing, errors, warnings
                      Else
                          boolstatus = swExportPDFData.SetSheets(swExportData_ExportSpecifiedSheets, sheetName)
                          swExportPDFData.ViewPdfAfterSaving = False
                          boolstatus = swMod.Extension.SaveAs(StripFilename(fileName) & ".pdf", 0, 0, swExportPDFData, errors, warnings)
                      End If
                  Next i
              End Sub
              
              
              Function StripFilename(fileName As String) As String
                  StripFilename = Left(fileName, Len(fileName) - 7)
              End Function