Makro-PDF-Aufnahme in mehreren Dateien

2D plans
1 
Hallo,
wir verwenden ein Makro, um eine Zeichnung in PDF und DXF zu speichern, ich kann es nicht so ändern, dass es 2 Blätter (oder mehr)
in einer einzigen PDF-Datei
speichert, wenn mir jemand helfen kann, danke im Voraus
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

Hallo

Sie müssen in der folgenden Zeile ändern:

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

Es ist diese Zeile, die nur das aktive Blatt exportiert, daher müssen Sie verschiedene Kriterien im Makro haben, um die richtige Aktion auszuwählen (alle Blätter, einige wenige...)

1 „Gefällt mir“
3

Vielen Dank für Ihre Antwort Cyril, ich möchte alle Blätter exportieren, ich habe es versucht, die For i-Schleife zu löschen, aber es funktioniert nicht mehr.

Ich bin kein Makroexperte!

 

4

Hallo fifounet44,

Dies sollte tun, was Sie wollen:

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

Herzliche Grüße

2 „Gefällt mir“
5

 

Guten Abend

Der Code von d.roger   oder dieser:

boolstatus = swExportPDFData.SetSheets(swExportData_ExportAllSheets, "")

 

2 „Gefällt mir“
6

Guten Abend D.Roger,
Danke, ich werde es am Montagmorgen versuchen, danke Cyril auch!
Schönes Wochenende

7

Hallo
Ich habe es gerade  ausprobiert und es funktioniert gut.
Als ich den Code sah, schien es einfach, alles ist einfacher, wenn man es beherrscht!
Nochmals vielen Dank.

 

1 „Gefällt mir“