Nagrywanie makr w formacie PDF z wieloma plikami

2D plans
1 
Witam,
Używamy makra do zapisania rysunku w formacie pdf i dxf, nie mogę go zmodyfikować tak, aby zapisywał 2 arkusze (lub więcej)
w jednym pliku pdf
, jeśli ktoś może mnie poprowadzić, z góry dziękuję
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

Witam

Musisz zmodyfikować w następującym wierszu:

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

To właśnie ta linia eksportuje tylko aktywny arkusz, więc musisz mieć różne kryteria w makrze, aby wybrać odpowiednią akcję (wszystkie arkusze, kilka...)

1 polubienie
3

Dziękuję za odpowiedź Cyryl, chcę wyeksportować wszystkie arkusze, próbowałem usunąć pętlę For i, ale to już nie działa.

Nie jestem ekspertem od makro!

 

4

Witaj fifounet44,

To powinno zrobić to, czego chcesz:

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

Pozdrowienia

2 polubienia
5

 

Dobry wieczór

Kod d.roger   lub ten:

boolstatus = swExportPDFData.SetSheets(swExportData_ExportAllSheets, "")

 

2 polubienia
6

Dobry wieczór d.roger,
Dziękuję, spróbuję w poniedziałek rano, dziękuję też Cyrylu!
Miłego weekendu

7

Witam
Właśnie  spróbowałem i działa dobrze.
Kiedy zobaczyłem kod, wydawał mi się prosty, wszystko jest łatwiejsze, gdy go opanujesz!
Jeszcze raz dziękuję.

 

1 polubienie