Macro multi file pdf recording

2D plans
1 
Hello,
We use a macro to save a drawing in pdf and dxf, I can't modify it so that it saves 2 sheets (or more)
in a single pdf
fileif someone can guide me, thank you in advance
Dim swApp As Object
Dim swModel As SldWorks.ModelDoc2
Dim swCustProp As CustomPropertyManager
Dim swSheet As SldWorks.Sheet
Dim vSheets As Variant
Dim i As Integer
Dim valOut1 As String
Dim valOut2 As String
Dim resolvedValOut1 As String
Dim resolvedValOut2 As String
Dim objShell   As Shell
Dim Folder As Object
Dim objFolder  As Folder
Dim objFile As Object
Dim Path As String
Dim nomb1 As String
Dim nomb2 As String
Dim nomb3 As String
Dim lettre As String
Dim Path1 As String
Dim Path2 As String
Dim swModelDocExt As SldWorks.ModelDocExtension
Dim swExportPDFData As SldWorks.ExportPdfData
Dim nFileName As String
Dim boolstatus As Boolean
Dim lErrors As Long
Dim lWarnings As Long

Sub main()
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set Part = swApp.ActiveDoc
    Set objShell = New Shell
    
        swPathName = Part.GetPathName
        nomb1 = Len(swPathName)
        nomb2 = InStrRev(swPathName, "\")
        nomb3 = nomb1 - nomb2
        swPath1 = Right(swPathName, nomb3)
        nomb = nomb3 - 7
        swPath2 = Left(swPath1, nomb)
        lettre = Left(swPath2, 1)
        swPath = Left(swPathName, InStrRev(swPathName, "\" & lettre, , 0))
        
        ' Pour savoir si le document est un plan
        If swModel.GetType = swDocDRAWING Then
            ' Pour récupérer les propriétés Solidworks
            Set swCustProp = swModel.Extension.CustomPropertyManager("")
            swCustProp.Get2 "REFERENCE PIECE", valOut1, resolvedValOut1
            swCustProp.Get2 "RĂ©vision", valOut2, resolvedValOut2
            ' Pour activer chaque feuille tour Ă  tour
            vSheets = swModel.GetSheetNames
            For i = 1 To swModel.GetSheetCount
                swModel.ActivateSheet vSheets(i - 1)
                Set swSheet = swModel.GetCurrentSheet
                
                ' Pour enregistrer la feuille en DXF
                Set swModelDocExt = swModel.Extension
                Set swExportPDFData = swApp.GetExportFileData(1)
                swExportPDFData.ViewPdfAfterSaving = False
                nFileName = swPath & "mises_en_plan\" & resolvedValOut1 & "-" & resolvedValOut2 & ".DXF"
                boolstatus = swExportPDFData.SetSheets(swExportData_ExportSpecifiedSheets, swSheet.GetName)
                boolstatus = swModelDocExt.SaveAs(nFileName, 0, 0, swExportPDFData, lErrors, lWarnings)
                ' Pour enregistrer la feuille en PDF
                Set swModelDocExt = swModel.Extension
                Set swExportPDFData = swApp.GetExportFileData(1)
                swExportPDFData.ViewPdfAfterSaving = True
                nFileName = swPath & "mises_en_plan\" & resolvedValOut1 & "-" & resolvedValOut2 & ".PDF"
                boolstatus = swExportPDFData.SetSheets(swExportData_ExportSpecifiedSheets, swSheet.GetName)
                boolstatus = swModelDocExt.SaveAs(nFileName, 0, 0, swExportPDFData, lErrors, lWarnings)
            Next i
            Else: swApp.SendMsgToUser ("Cette macro fonctionne uniquement avec une mise en plan")
        End If
End Sub

 

2

Hello

You have to modify in the following line:

boolstatus = swExportPDFData.SetSheets(swExportData_ExportSpecifiedSheets, swSheet.GetName)

It is this line that only exports the active sheet, so you need to have different criteria in the macro to select the right action (all the sheets, a few...)

1 Like
3

Thank you for your answer Cyril, I want to export all the sheets, I tried by deleting the For i loop, but it doesn't work anymore.

I'm not a macro expert!

 

4

Hello fifounet44,

This should do what you want:

Dim swApp As Object
Dim swModel As SldWorks.ModelDoc2
Dim swCustProp As CustomPropertyManager
Dim swSheet As SldWorks.Sheet
Dim vSheets As Variant
Dim i As Integer
Dim valOut1 As String
Dim valOut2 As String
Dim resolvedValOut1 As String
Dim resolvedValOut2 As String
Dim objShell   As Shell
Dim Folder As Object
Dim objFolder  As Folder
Dim objFile As Object
Dim Path As String
Dim nomb1 As String
Dim nomb2 As String
Dim nomb3 As String
Dim lettre As String
Dim Path1 As String
Dim Path2 As String
Dim swModelDocExt As SldWorks.ModelDocExtension
Dim swExportPDFData As SldWorks.ExportPdfData
Dim nFileName As String
Dim boolstatus As Boolean
Dim lErrors As Long
Dim lWarnings As Long

Sub main()
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set Part = swApp.ActiveDoc
    Set objShell = New Shell
    
        swPathName = Part.GetPathName
        nomb1 = Len(swPathName)
        nomb2 = InStrRev(swPathName, "\")
        nomb3 = nomb1 - nomb2
        swPath1 = Right(swPathName, nomb3)
        nomb = nomb3 - 7
        swPath2 = Left(swPath1, nomb)
        lettre = Left(swPath2, 1)
        swPath = Left(swPathName, InStrRev(swPathName, "\" & lettre, , 0))
        
        ' Pour savoir si le document est un plan
        If swModel.GetType = swDocDRAWING Then
            ' Pour récupérer les propriétés Solidworks
            Set swCustProp = swModel.Extension.CustomPropertyManager("")
            swCustProp.Get2 "REFERENCE PIECE", valOut1, resolvedValOut1
            swCustProp.Get2 "RĂ©vision", valOut2, resolvedValOut2
            ' Pour activer chaque feuille tour Ă  tour
            vSheets = swModel.GetSheetNames
                
            ' Pour enregistrer la feuille en DXF
            Set swModelDocExt = swModel.Extension
            Set swExportPDFData = swApp.GetExportFileData(1)
            swExportPDFData.ViewPdfAfterSaving = False
            nFileName = swPath & "mises_en_plan\" & resolvedValOut1 & "-" & resolvedValOut2 & ".DXF"
            boolstatus = swExportPDFData.SetSheets(swExportData_ExportSpecifiedSheets, vSheets)
            boolstatus = swModelDocExt.SaveAs(nFileName, 0, 0, swExportPDFData, lErrors, lWarnings)
            ' Pour enregistrer la feuille en PDF
            Set swModelDocExt = swModel.Extension
            Set swExportPDFData = swApp.GetExportFileData(1)
            swExportPDFData.ViewPdfAfterSaving = True
            nFileName = swPath & "mises_en_plan\" & resolvedValOut1 & "-" & resolvedValOut2 & ".PDF"
            boolstatus = swExportPDFData.SetSheets(swExportData_ExportSpecifiedSheets, vSheets)
            boolstatus = swModelDocExt.SaveAs(nFileName, 0, 0, swExportPDFData, lErrors, lWarnings)

            Else: swApp.SendMsgToUser ("Cette macro fonctionne uniquement avec une mise en plan")
        End If
End Sub

Kind regards

2 Likes
5

 

Good evening

The code of d.roger   or this one:

boolstatus = swExportPDFData.SetSheets(swExportData_ExportAllSheets, "")

 

2 Likes
6

Good evening d.roger,
Thank you, I'll try on Monday morning, thank you Cyril too!
Have a good weekend

7

Hello
I just  tried it and it works fine.
When I see the code it seemed simple, everything is easier when you master it!
Thank you again.

 

1 Like