Ich suche nach einer Möglichkeit, den Weg zu einem VBA-Teil zu finden, das in eine Zeichnung eingefügt wurde.
Mein Szenario sieht wie folgt aus:
Ich habe meinen Raum geöffnet, ich erstelle eine Zeichnung meines Raumes und ich möchte eine automatische Aufzeichnung in einem anderen Format machen. Aber ich sehe nicht, wie ich den Weg zurück zu meinem Stück aus der Zeichnung finden kann.
Hat jemand von Ihnen die Lösung? Da er sicherlich eine Lösung hat, habe ich versucht zu suchen, aber ich habe sie noch nicht gefunden...
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
Hallo @max59 ich habe mir die Freiheit genommen, den Beitrag zu bearbeiten, um das Makro wieder zwischen die Tags zu setzen, weil sonst der Übersetzer... Das Schönste war, dass am Ende des Makros die Übersetzung von " End Sub " durch " End of the Submarine " war, es hat mir den Tag versüßt
