6 Replies Latest reply on Jun 25, 2014 3:22 PM by Deepak Gupta

    Save Each Sheet As PDF - Help

    Tyler Banschbach

      I am attempting to divide out a drawing file into multiple PDFs based on the sheet names. I found the attached is code and downloaded from 3D content central. I haven't recieved a response yet from the creator so I'm bringing it up to you all. I can't use this code though multiple people on 3D Content Central have used it successfully. When I run it, SW tells me there is an error @ ...

       

      'declare and set modelDoc object

       

          Dim swDoc As ModelDoc2

          Set swDoc = swApp.ActiveDoc

       

      While I am terrible with VBA as of yet I do understand that this code may need some revising for my specific files/filepaths. I am desperately looking for help here. This task will take a great deal of time if I have to do manually so please help ...

       

      Message was edited by: Tyler Banschbach

        • Re: Save Each Sheet As PDF - Help
          Deepak Gupta

          Which version of SolidWorks you're running this macro on. I think you need to fix the references in the macro.

           

          To fix libraries, open the macro (Tools > Macro > Edit). Go to references, uncheck the three highlighted libraries in the picture or missing libraries and select same for your version of SolidWorks. Save the macro and run again.

           

          https://forum.solidworks.com/servlet/JiveServlet/download/353474-96197/Fix%20Library.PNG

           

          These posts have several more macros (with various output options) if you want to try out:

           

          https://forum.solidworks.com/message/322155#322155

           

          https://forum.solidworks.com/message/353413#353413

            • Re: Save Each Sheet As PDF - Help
              Tyler Banschbach

              Hi Deepak,

               

              I am running 2014 and have checked the boxes as you require for solidworks 2014. The code pasted below has worked spottingly but doesn't do what I want even when it works (though close). Any attempt at modifying it myself has failed thus far so I'm back on here asking for help. What I am needing is for the macro to save each sheet in my file as a pdf under the name: " [file name] [-] [sheet name]" for instance one of the pdfs would save out as ... DGD008050 - Sanded , where DGD008050 is the file name and Sanded is the sheet name. I would love it if somehow the macro new to save the "sanded pdfs" to the specific directory where the folder's name is "Sanded PDFs" and then for the "Non Sanded" sheet names it new to save those pdfs out in the same base directory but the folder's name is "Non Sanded PDFs" and so on and so forth for the rest of the sheets. This is likely to much to ask so instead I am happy with all of the pdfs saving out to an allocated directory where I will create the folders and seperate each pdf into their respective folder manually.

              _________________________________________________________________________________________________________

               

              Option Explicit

               

               

              Dim swApp As SldWorks.SldWorks

               

               

              Sub main()

               

               

                  Set swApp = Application.SldWorks

                 

                  'check for valid solidworks application

                  If swApp Is Nothing Then

                     

                      MsgBox "Error Connecting to SolidWorks. Please Try Again.", vbCritical

                      Exit Sub

                     

                  End If

                 

                  'declare and set modelDoc object

                  Dim swDoc As ModelDoc2

                  Set swDoc = swApp.ActiveDoc

                 

                  'check for valid document

                  If swDoc Is Nothing Then

                     

                      MsgBox "Unable to Connect to a Valid SolidWorks Drawing.", vbCritical

                      Exit Sub

                     

                  End If

                 

                  'check for valid drawing

                  If swDoc.GetType <> SwConst.swDocumentTypes_e.swDocDRAWING Then

                     

                      MsgBox "Unable to Connect to a Valid SolidWorks Drawing.", vbCritical

                      Exit Sub

                     

                  End If

                 

                  'Declare and set drawing object

                  Dim swDwgDoc As DrawingDoc

                  Set swDwgDoc = swDoc

                 

                  'declare and set exporter object

                  Dim swExporter As SldWorks.ExportPdfData

                  Set swExporter = swApp.GetExportFileData(SwConst.swExportDataFileType_e.swExportPdfData)

                 

                  'declare and set output directory to current path

                  Dim outputPath As String

                  outputPath = getFolderFromFullPath(swDoc.GetPathName)

                 

                  'create and set array for sheet names

                  Dim sheetNames As Variant

                  sheetNames = swDwgDoc.GetSheetNames

                 

                  'create and set object for current sheet

                  Dim CurDwgSheet As Sheet

                  Set CurDwgSheet = swDwgDoc.GetCurrentSheet

                 

                  'create base out name

                  Dim outputFileName As String

                  outputFileName = getTitleFromFullTitle(swDoc.GetTitle, CurDwgSheet.GetName)

                 

                  'errors and warnings objects

                  Dim lErrors As Long

                  Dim lWarnings As Long

                  Dim i As Integer

                  Dim bRet As Boolean

                 

                  'create frame and status bar pane object

                  Dim statusPane As StatusBarPane

                  Dim swFrame As SldWorks.Frame

                 

                  Set swFrame = swApp.Frame

                  Set statusPane = swFrame.GetStatusBarPane

                  statusPane.Visible = True

                 

                 

                  'loop through and export each sheet

                  For i = 0 To UBound(sheetNames)

                     

                      'update status pane

                      statusPane.Text = "Exporting " + sheetNames(i)

                     

                      'update exporter object

                      bRet = swExporter.SetSheets(SwConst.swExportDataSheetsToExport_e.swExportData_ExportSpecifiedSheets, sheetNames(i))

                     

                      'check for errors

                      If bRet = False Then

                     

                          MsgBox "Error Creating PDF on Sheet: " + Str(i)

                          Exit Sub

                     

                      End If

                     

                      'save out pdf

                      bRet = swDoc.Extension.SaveAs(outputPath + outputFileName + " - " + sheetNames(i) + ".pdf", SwConst.swSaveAsVersion_e.swSaveAsCurrentVersion, SwConst.swSaveAsOptions_e.swSaveAsOptions_Silent, _

                          swExporter, lErrors, lWarnings)

                     

                      'check for errors

                      If bRet = False Then

                         

                          MsgBox "Error Creating PDF on Sheet: " + Str(i)

                          CatchErrors lErrors

                          Exit Sub

                         

                      End If

                         

                  Next i

                 

              End Sub

               

               

              Private Function getFolderFromFullPath(thefullpath As String) As String

                 

                  'returns the path without the filename

                  getFolderFromFullPath = Strings.Mid(thefullpath, 1, Strings.Len(thefullpath) - ((Strings.Len(thefullpath) - Strings.InStrRev(thefullpath, "\"))))

                 

              End Function

               

               

              Private Function getTitleFromFullTitle(thefulltitle As String, thesheetname As String) As String

                 

                  'returns filename without sheet name

                  getTitleFromFullTitle = Strings.Mid(thefulltitle, 1, Strings.Len(thefulltitle) - ((Strings.Len(thefulltitle) - Strings.InStrRev(thefulltitle, thesheetname) + 4)))

                 

              End Function

               

               

              Private Sub CatchErrors(theError As Long)

                 

                  Select Case theError

                     

                      Case 0

                     

                      Case SwConst.swFileSaveError_e.swGenericSaveError

                     

                          MsgBox "File Saving Error", vbExclamation

                         

                      Case SwConst.swFileSaveError_e.swReadOnlySaveError

                         

                          MsgBox "File Saving Error: Read-Only Rights", vbExclamation

                         

                      Case SwConst.swFileSaveError_e.swFileNameEmpty

                     

                          MsgBox "File Saving Error: Empty Filename", vbExclamation

                     

                      Case SwConst.swFileSaveError_e.swFileNameContainsAtSign

                     

                          MsgBox "File Saving Error: Invalid FileName Character", vbExclamation

                         

                      Case SwConst.swFileSaveError_e.swFileSaveFormatNotAvailable

                     

                          MsgBox "File Saving Error: Invalid File Format", vbExclamation

                         

                      Case SwConst.swFileSaveError_e.swFileSaveAsNameExceedsMaxPathLength

                     

                          MsgBox "File Saving Error: Filename Exceeds Maximum Path Length of 255 Characters", vbExclamation

                         

                  End Select

               

               

              End Sub

                • Re: Save Each Sheet As PDF - Help
                  Tom Bostick

                  I ran it yesterday and had problems until I added the 'Solidworks Utilities 2013 Type Library' reference also.

                  No problems after that.

                    • Re: Save Each Sheet As PDF - Help
                      Tyler Banschbach

                      Nobody wants to take a shot at it?

                        • Re: Save Each Sheet As PDF - Help
                          Tom Bostick

                          Replace the "save out pdf" section of code with this. If sheet name is "Sanded", "Non Sanded" or other it will go to respective folders or the drawing directory. Sanded/Non Sanded folders are subfolder of the drawing's folder.

                           

                                  'save out pdf

                                  If sheetNames(i) = "Sanded" Then

                                      bRet = swDoc.Extension.SaveAs(outputPath + "Sanded\" + outputFileName + " - " + sheetNames(i) + ".pdf", SwConst.swSaveAsVersion_e.swSaveAsCurrentVersion, SwConst.swSaveAsOptions_e.swSaveAsOptions_Silent, _

                                      swExporter, lErrors, lWarnings)

                                  ElseIf sheetNames(i) = "Non Sanded" Then

                                      bRet = swDoc.Extension.SaveAs(outputPath + "Non Sanded\" + outputFileName + " - " + sheetNames(i) + ".pdf", SwConst.swSaveAsVersion_e.swSaveAsCurrentVersion, SwConst.swSaveAsOptions_e.swSaveAsOptions_Silent, _

                                      swExporter, lErrors, lWarnings)

                                  Else

                                      bRet = swDoc.Extension.SaveAs(outputPath + outputFileName + " - " + sheetNames(i) + ".pdf", SwConst.swSaveAsVersion_e.swSaveAsCurrentVersion, SwConst.swSaveAsOptions_e.swSaveAsOptions_Silent, _

                                      swExporter, lErrors, lWarnings)

                                  End If

                            • Re: Save Each Sheet As PDF - Help
                              Deepak Gupta

                              You can further add some more codes to create Sanded, No-Sanded folder in case they don't exist

                               

                              'save out pdf

                                      If sheetNames(i) = "Sanded" Then

                                        'Check/Create Directory

                                      If Dir(outputPath + "Sanded") = "" Then

                                      MkDir outputPath + "Sanded"

                                        bRet = swDoc.Extension.SaveAs(outputPath + "Sanded\" + outputFileName + " - " + sheetNames(i) + ".pdf", SwConst.swSaveAsVersion_e.swSaveAsCurrentVersion, SwConst.swSaveAsOptions_e.swSaveAsOptions_Silent, _

                                          swExporter, lErrors, lWarnings)

                                      Else

                                          bRet = swDoc.Extension.SaveAs(outputPath + "Sanded\" + outputFileName + " - " + sheetNames(i) + ".pdf", SwConst.swSaveAsVersion_e.swSaveAsCurrentVersion, SwConst.swSaveAsOptions_e.swSaveAsOptions_Silent, _

                                          swExporter, lErrors, lWarnings)

                                      End If

                               

                               

                               

                               

                                      ElseIf sheetNames(i) = "Non Sanded" Then

                                        'Check/Create Directory

                                      If Dir(outputPath + "Non Sanded") = "" Then

                                      MkDir outputPath + "Non Sanded"

                                        bRet = swDoc.Extension.SaveAs(outputPath + "Non Sanded\" + outputFileName + " - " + sheetNames(i) + ".pdf", SwConst.swSaveAsVersion_e.swSaveAsCurrentVersion, SwConst.swSaveAsOptions_e.swSaveAsOptions_Silent, _

                                          swExporter, lErrors, lWarnings)

                                      Else

                               

                               

                                          bRet = swDoc.Extension.SaveAs(outputPath + "Non Sanded\" + outputFileName + " - " + sheetNames(i) + ".pdf", SwConst.swSaveAsVersion_e.swSaveAsCurrentVersion, SwConst.swSaveAsOptions_e.swSaveAsOptions_Silent, _

                                          swExporter, lErrors, lWarnings)          

                                                   

                                          End If

                                         

                                      Else

                                          bRet = swDoc.Extension.SaveAs(outputPath + outputFileName + " - " + sheetNames(i) + ".pdf", SwConst.swSaveAsVersion_e.swSaveAsCurrentVersion, SwConst.swSaveAsOptions_e.swSaveAsOptions_Silent, _

                                          swExporter, lErrors, lWarnings)

                                      End If