Macro multi file pdf opname

2D plans
1 
Hallo,
We gebruiken een macro om een tekening op te slaan in pdf en dxf, ik kan het niet wijzigen zodat het 2 vellen (of meer)
in een enkel pdf-bestand
opslaatals iemand me kan begeleiden, bij voorbaat dank
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

U moet op de volgende regel wijzigen:

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

Het is deze regel die alleen het actieve blad exporteert, dus u moet verschillende criteria in de macro hebben om de juiste actie te selecteren (alle bladen, een paar...)

1 like
3

Bedankt voor je antwoord Cyril, ik wil alle vellen exporteren, ik heb geprobeerd de For i-lus te verwijderen, maar het werkt niet meer.

Ik ben geen macro-expert!

 

4

Hallo fifounet44,

Dit zou moeten doen wat je wilt:

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

Vriendelijke groeten

2 likes
5

 

Goedenavond

De code van d.roger   of deze:

boolstatus = swExportPDFData.SetSheets(swExportData_ExportAllSheets, "")

 

2 likes
6

Goedenavond D.Roger,
Bedankt, ik zal het maandagochtend proberen, ook bedankt Cyril!
Fijn weekend

7

Hallo
Ik heb het net  geprobeerd en het werkt prima.
Als ik de code zie, lijkt het simpel, alles is gemakkelijker als je het onder de knie hebt!
Nogmaals bedankt.

 

1 like