Macro enregistrer sous PDF 3D

Out of category
1

Bonjour je cherche à faire une macro pour enregistrer sous un assemblage ou une pièce en PDF 3D, mais je ne c'est pas comment faire. j'ai bien trouvé quelque chose avec "ExportAs3D" mais je ne sais pas comment faire pour l'intégrer dans mon code. est-ce que quelqu'un aurait la solution ?

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

Bonjour, Ca devrait être ca:

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 « J'aime »
3

merci JeromeP c'est excatement ça :)

4

Bonjour, super la macro ! Je l'ai récupéré pour réaliser la mienne mais avec quelques modifications. J'ai modifié pour que le document se renomme avec le nom du ficher et s'enregistre dans le même document que celui créer. Je souhaiterais juste ajouter PDF3D à la fin de mon fichier de sortie mais je n'y arrive pas. Je suis un grand novice en matière de création de macro, pouvez-vous m'indiquer ou me modifier ce que j'ai créé pour que cela fonctionne ? 

 Option Explicit
    Dim swApp               As SldWorks.SldWorks
    Dim swModel             As SldWorks.ModelDoc2
    Dim swModelDocExt       As SldWorks.ModelDocExtension
    Dim swExportData        As SldWorks.ExportPdfData
    Dim sPathName           As String
    Dim boolstatus          As Boolean
    Dim filename            As String
    Dim lErrors             As Long
    Dim lWarnings           As Long
    Dim ActiveConfig As String
    Dim NomDossierDestination As String
    
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(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\poste5\Documents\Projets\"
    filename = swModel.GetPathName
    filename = Strings.Left(filename, Len(filename) - 7) + ".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

5

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

Quelque chose comme ça devrait fonctionner

1 « J'aime »
6

Merci !!