Je cherche le moyen de trouver le chemin d’une pièce en VBA qui a été insérer dans une mise en plan.
Mon scenario est le suivant :
J’ai ma pièce qui est ouvert, je crée une mise en plan de ma pièce et je veux faire un enregistrement automatique sous différent format.
Mais je ne vois pas comment récupérer le chemin de ma pièce depuis la mise en plan.
Quelqu’un de vous aurait la solution?
Car il a certainement une solution, j’ai essayé de cherché, mais je n’ai pas trouvé pour l’instant…
Sub ExportDrawingWithReferencedPartToPDFandDXF()
' Déclaration des variables
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swDraw As SldWorks.DrawingDoc
Dim swView As SldWorks.View
Dim swModelInView As SldWorks.ModelDoc2
Dim partFilePath As String
Dim drawingFilePath As String
Dim exportPDFPath As String
Dim exportDXFPath As String
Dim errors As Long
Dim warnings As Long
' Initialisation de SolidWorks
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
' Vérification que le document actif est bien une mise en plan
If swModel.GetType <> swDocDRAWING Then
MsgBox "Le document actif n'est pas une mise en plan."
Exit Sub
End If
' Caster le document en tant que DrawingDoc
Set swDraw = swModel
' Récupérer la première vue contenant le modèle
Set swView = swDraw.GetFirstView
Set swView = swView.GetNextView ' Ignorer la vue de la feuille et prendre la première vue du modèle
' Vérifier si la vue fait référence à un modèle
If Not swView Is Nothing Then
Set swModelInView = swView.ReferencedDocument
If Not swModelInView Is Nothing Then
' Récupérer le chemin du fichier de la pièce référencée
partFilePath = swModelInView.GetPathName
If partFilePath <> "" Then
MsgBox "Le chemin du modèle inséré est : " & partFilePath
Else
MsgBox "La pièce n'a pas encore été enregistrée."
End If
Else
MsgBox "Aucun modèle n'est associé à cette vue."
Exit Sub
End If
End If
' Récupérer le chemin de la mise en plan (le fichier de dessin)
drawingFilePath = Left(swModel.GetPathName, InStrRev(swModel.GetPathName, ".") - 1)
' Si la mise en plan n'a pas encore été enregistrée
If drawingFilePath = "" Then
MsgBox "La mise en plan n'a pas encore été enregistrée."
Exit Sub
End If
' Générer les chemins pour l'export PDF et DXF
exportPDFPath = drawingFilePath & ".pdf"
exportDXFPath = drawingFilePath & ".dxf"
' Exporter la mise en plan en PDF
swModel.SaveAs3 exportPDFPath, 0, 0
MsgBox "Exportation en PDF réussie : " & exportPDFPath
' Exporter la mise en plan en DXF
swModel.SaveAs4 exportDXFPath, swSaveAsDXF, swSaveAsOptions_Silent, errors, warnings
If errors = 0 Then
MsgBox "Exportation en DXF réussie : " & exportDXFPath
Else
MsgBox "Erreur lors de l'exportation en DXF."
End If
End Sub
Bonjour, @max59 je me suis permis d’éditer le post pour remettre la macro entre les balises car sinon le traducteur fait de la m…
Le plus beau étant à la fin de la macro la traduction de « End sub » par « fin du sous marin », ça m’a fait ma journée
