Macro opslaan als 3D PDF

Out of category
1

Hallo, ik ben op zoek naar een macro om op te slaan onder een assemblage of een onderdeel in 3D PDF, maar ik weet niet hoe ik dat moet doen. Ik heb wel iets gevonden met "ExportAs3D", maar ik weet niet hoe ik het in mijn code moet integreren. Heeft iemand de oplossing?

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, Het zou dit moeten zijn:

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 likes
3

dank je wel JeromeP, dat is het precies:)

4

Hallo, grote macro ! Ik kreeg het terug om mijn eigen te maken, maar met een paar aanpassingen. Ik heb het zo gewijzigd dat het document zichzelf hernoemt met de naam van het bestand en wordt opgeslagen in hetzelfde document als het document dat ik heb gemaakt . Ik wil gewoon PDF3D toevoegen aan het einde van mijn uitvoerbestand, maar dat lukt me niet. Ik ben een grote beginner als het gaat om het maken van macro's, kun je me vertellen of aanpassen wat ik heb gemaakt om het te laten werken? 

 Expliciete optie
Dim swApp               als SldWorks.SldWorks   
Dim swModel             als SldWorks.ModelDoc2   
    Dim swModelDocExt       als SldWorks.ModelDocExtension
    Dim swExportData        As SldWorks.ExportPdfData
Dim sPathName           als tekenreeks   
Dim boolstatus          als Booleaanse   
Dim bestandsnaam            als tekenreeks   
Dim lErrors             zo lang   
Dim lWaarschuwingen           zo lang mogelijk   
    Dim ActiveConfig als tekenreeks
    Dim FolderNameDestination als tekenreeks
    
Sub hoofd()
    Stel swApp = Toepassing.SldWorks in
    Stel swModel = swApp.ActiveDoc in
    Als swModel niets is, dan
        MsgBox "Geen assemblage of onderdeel in uitvoering", vbCritical
        Einde
    Einde als
    Als swModel.GetType <> swDocASSEMBLY en swModel.GetType <> swDocPART Dan
        MsgBox "Deze macro werkt alleen op assemblages of onderdelen", vbCritical
        Einde
    Einde als
    Stel swModelDocExt = swModel.Extension in
    Stel swExportData = swApp.GetExportFileData(1) in
    swExportData.ExportAs3D = Waar
    
    bestandsnaam = swModel.GetPathName
    Als bestandsnaam = "" Dan
        MsgBox "Sla het bestand eerst op en probeer het opnieuw", vbCritical
        Einde
    Einde als
    
ActiveConfig = swApp.GetActiveConfigurationName(bestandsnaam)

    DestinationFolderName = "C:\Gebruikers\Positie5\Documenten\Projecten\"
    bestandsnaam = swModel.GetPathName
    bestandsnaam = Strings.Left(bestandsnaam, Len(bestandsnaam) - 7) + ".PDF"
    swModel.ForceRebuild3 Waar
    swModel.ShowNamedView2 "Dimetrisch", 9
    swModel.ViewZoomtofit2
    boolstatus = swModelDocExt.SaveAs(bestandsnaam, 0, 0, swExportData, lErrors, lWarnings)

    Als boolstatus Dan
        MsgBox "Succesvolle 3D PDF Registratie" & vbNewLine & bestandsnaam
    Anders
        MsgBox "Kan niet worden opgeslagen als 3D PDF, foutcode:" & lErrors
    Einde als
Einde Sub

5

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

Zoiets zou moeten werken

1 like
6

Bedankt!!