Makro als 3D-PDF speichern

Out of category
1

Hallo, ich möchte ein Makro erstellen, um es unter einer Baugruppe oder einem Teil in 3D-PDF zu speichern, aber ich weiß nicht, wie es geht. Ich habe etwas mit "ExportAs3D" gefunden, weiß aber nicht, wie ich es in meinen Code integrieren soll. Hat jemand die Lösung?

Option Explicit
    Dim swApp               As SldWorks.SldWorks
    Dim swModel             As SldWorks.ModelDoc2
    Dim swModelDocExt       As SldWorks.ModelDocExtension
    Dim swExportData          As SldWorks.ExportPdfData
    Dim boolstatus          As Boolean
    Dim filename            As String
    Dim lErrors             As Long
    Dim lWarnings           As Long
    Dim ActiveConfig As String
    
'Dim instance As IExportPdfData
'Dim value As System.Boolean
'
'instance.ExportAs3D = value
'value = instance.ExportAs3D
    
Sub main()
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    If swModel Is Nothing Then
        MsgBox "Aucun assemblage ou pièce en cours", vbCritical
        End
    End If
    If swModel.GetType <> swDocASSEMBLY And swModel.GetType <> swDocPART Then
        MsgBox "Cette Macro ne fonctionne que sur les Assemblages ou les pièces", vbCritical
        End
    End If
    Set swModelDocExt = swModel.Extension
    Set swExportData = swApp.GetExportFileData(swExportPdfData)
    filename = swModel.GetPathName
    If filename = "" Then
        MsgBox "Sauvegarder d'abord le fichier et réessayez", vbCritical
        End
    End If
       
    ActiveConfig = swApp.GetActiveConfigurationName(filename)
    
    Dim NomDossierDestination As String
    NomDossierDestination = "C:\Users\Edouard\Desktop\"
  
    swModel.ForceRebuild3 True
    swModel.ShowNamedView2 "Dimetric", 9
    swModel.ViewZoomtofit2
  
    filename = NomDossierDestination & ActiveConfig & ".PDF"
    
    '-------------------------------------------------------------------------------------

    boolstatus = swExportData.SetSheets(swExportData_ExportAllSheets, 1)
    boolstatus = swModelDocExt.SaveAs(filename, 0, 0, swExportData, lErrors, lWarnings)
    If boolstatus Then
        MsgBox "Enregistrement au format PDF 3D réussi" & vbNewLine & filename
    Else
        MsgBox "Echec de l'enregistrement au format PDF 3D, Error code:" & lErrors
    End If
End Sub

 

2

Hallo, es sollte so sein:

Option Explicit
Sub main()
    Dim swApp               As SldWorks.SldWorks
    Dim swModel             As SldWorks.ModelDoc2
    Dim swModelDocExt       As SldWorks.ModelDocExtension
    Dim swExportData        As SldWorks.ExportPdfData
    Dim boolstatus          As Boolean
    Dim filename            As String
    Dim lErrors             As Long
    Dim lWarnings           As Long
    Dim ActiveConfig As String
    Dim NomDossierDestination As String
    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    If swModel Is Nothing Then
        MsgBox "Aucun assemblage ou pièce en cours", vbCritical
        End
    End If
    If swModel.GetType <> swDocASSEMBLY And swModel.GetType <> swDocPART Then
        MsgBox "Cette Macro ne fonctionne que sur les Assemblages ou les pièces", vbCritical
        End
    End If
    Set swModelDocExt = swModel.Extension
    Set swExportData = swApp.GetExportFileData(1)
    swExportData.ExportAs3D = True
    
    filename = swModel.GetPathName
    If filename = "" Then
        MsgBox "Sauvegarder d'abord le fichier et réessayez", vbCritical
        End
    End If

    ActiveConfig = swApp.GetActiveConfigurationName(filename)

    NomDossierDestination = "C:\Users\Edouard\Desktop\"
    filename = NomDossierDestination & ActiveConfig & ".PDF"
    swModel.ForceRebuild3 True
    swModel.ShowNamedView2 "Dimetric", 9
    swModel.ViewZoomtofit2
    boolstatus = swModelDocExt.SaveAs(filename, 0, 0, swExportData, lErrors, lWarnings)
    If boolstatus Then
        MsgBox "Enregistrement au format PDF 3D réussi" & vbNewLine & filename
    Else
        MsgBox "Echec de l'enregistrement au format PDF 3D, Error code:" & lErrors
    End If
End Sub

 

2 „Gefällt mir“
3

Danke JeromeP, das ist es genau:)

4

Hallo, tolles Makro ! Ich habe es zurückbekommen , um mein eigenes zu machen, aber mit ein paar Änderungen. Ich habe es so geändert , dass sich das Dokument mit dem Namen der Datei umbenennt und im selben Dokument speichert, das ich erstellt habe . Ich möchte PDF3D nur am Ende meiner Ausgabedatei hinzufügen, kann es aber nicht. Ich bin ein großer Anfänger, wenn es um die Erstellung von Makros geht, können Sie mir sagen oder ändern, was ich erstellt habe , damit es funktioniert? 

 Explizite Option
Dim swApp               als SldWorks.SldWorks   
Dim swModel             As SldWorks.ModelDoc2   
    Dim swModelDocExt       As SldWorks.ModelDocExtension
    Dim swExportData        As SldWorks.ExportPdfData
Dim sPathName           als Zeichenfolge   
Dim boolstatus          als boolescher Wert   
Dim-Dateiname            als Zeichenfolge   
    Fehler             so lange dimmen
Dim lWarnungen           so lange   
    ActiveConfig als Zeichenfolge dimmen
    Dim FolderNameDestination As String
    
Sub main()
    Legen Sie swApp = Application.SldWorks fest
    Festlegen von swModel = swApp.ActiveDoc
    Wenn swModel nichts ist, dann
        MsgBox "Keine Montage oder kein Teil in Arbeit", vbCritical
        Ende
    Ende, wenn
    If swModel.GetType <> swDocASSEMBLY Und swModel.GetType <> swDocPART Dann
        MsgBox "Dieses Makro funktioniert nur bei Baugruppen oder Teilen", vbCritical
        Ende
    Ende, wenn
    Legen Sie swModelDocExt = swModel.Extension fest
    Set swExportData = swApp.GetExportFileData(1)
    swExportData.ExportAs3D = Wahr
    
    Dateiname = swModel.GetPathName
    Wenn Dateiname = "" Dann
        MsgBox "Speichern Sie zuerst die Datei und versuchen Sie es erneut", vbCritical
        Ende
    Ende, wenn
    
ActiveConfig = swApp.GetActiveConfigurationName(Dateiname)

    DestinationFolderName = "C:\Benutzer\Position5\Dokumente\Projekte\"
    Dateiname = swModel.GetPathName
    Dateiname = Strings.Left(Dateiname, Len(Dateiname) - 7) + ".PDF"
    swModel.ForceRebuild3 Wahr
    swModel.ShowNamedView2 "Dimetrisch", 9
    swModel.ViewZoomtofit2
    boolstatus = swModelDocExt.SaveAs(Dateiname, 0, 0, swExportData, lErrors, lWarnings)

    Wenn boolstatus Dann
        MsgBox "Erfolgreiche 3D-PDF-Registrierung" & vbNewLine & Dateiname
    Oder
        MsgBox "Fehler beim Speichern als 3D-PDF, Fehlercode:" & lFehler
    Ende, wenn
Ende Sub

5

filename = Strings.Left(Dateiname, Len(Dateiname) - 7) + "-PDF3D.PDF"

So etwas sollte funktionieren

1 „Gefällt mir“
6

Vielen Dank!!