Cze wszystkim
Szukam sposobu, aby znaleźć drogę do części VBA, która została wstawiona do rysunku.
Mój scenariusz jest następujący:
Mam swój pokój, który jest otwarty, tworzę rysunek mojego pokoju i chcę zrobić automatyczne nagranie w innym formacie.
Ale nie widzę, jak odzyskać drogę powrotną do mojego dzieła z rysunku.
Czy ktoś z Was ma rozwiązanie?
Ponieważ na pewno ma rozwiązanie, próbowałem szukać, ale jeszcze go nie znalazłem...
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
Witam
@max59 Pozwoliłem sobie edytować post, aby umieścić makro z powrotem między tagami, ponieważ w przeciwnym razie tłumacz robi...
Najpiękniejsze jest to, że na końcu makro tłumaczenie " End sub " przez " end of the submarine ", to sprawiło, że mój dzień 
Witam
Może jakiś trop: https://help.solidworks.com/2020/english/api/sldworksapi/Get_Components_Properties_in_Drawing_View_Example_VB.htm
Krótko mówiąc, zachowujesz wszystko z kodu, który jest niezbędny do wykonania tej linii:
Debug.Print sPadStr & " File = " & swDrawComp.component.GetPathName