Ich bin dabei, ein Makro zu erstellen, das es mir ermöglicht, das in einer Zeichnung verwendete Modell durch ein anderes zu ersetzen, dieser Code wird in einen anderen größeren Code integriert, der darin besteht, eine automatische Kopie eines Bibliotheksteils zu erstellen, um es mit einem Klick in ein benutzerdefiniertes Teil umzuwandeln und im Hauptbaugruppenordner zu speichern. Alles funktioniert, das Teil wird gut kopiert, wird in der Baugruppe gut durch das neue ersetzt, der Plan wird gut kopiert, aber der Plan behält die Verbindung zum alten Teil bei, so dass ich das Referenzdokument ändern muss, wo es blockiert, ich kann es nicht richtig verwenden. ReplaceReferencedDocument( ) oder . SetReferencedModelName richtig denke ich.
Ich kann in VBA nicht viele Informationen zu diesem Thema finden.
Hier ist mein Code-Schnipsel, newplanpath und oldpartpath sind die vollständigen Pfade meines alten und neuen Teils:
Dim referencesUpdated As Boolean
If fso.FileExists(newPlanPath) Then
' Ouvrir le plan
Set swDraw = swApp.OpenDoc6(newPlanPath, swDocDRAWING, swOpenDocOptions_Silent, "", 0, 0)
If Not swDraw Is Nothing Then
' Modifier la référence du fichier
referencesUpdated = swDraw.ReplaceReferencedDocument(oldPartPath, newPartPath)
' Sauvegarde et fermeture du plan
swDraw.Save
swApp.CloseDoc newPlanPath
Es eröffnet mir den Plan, ersetzt aber überhaupt nichts... Ich habe andere Methoden getestet, z. B. das Durchsuchen aller Ansichten und das Ersetzen des Referenzmodells für jede Ansicht, aber es funktioniert auch nicht ...
Ich habe dieses Makro, das ein Teil indiziert (speichern Sie wie in einer vorherigen Funktion zu der angegebenen Funktion) und kopiert seine Zeichnung, schauen Sie es sich an und lassen Sie sich von diesem Stück Code inspirieren:
Function incrementationIndicePlan()
Debug.Print " Function incrementationIndicePlan lancé"
'on vérifie si un indice est existant et on sauvegarde l'ancien
OldIndice = Indice
Debug.Print "OldIndice:" & OldIndice
'Maj 2023-06-12 Si Indice = " " on force l'Indice pour avoir la valeur A
If Indice = "" Or Indice = " " Then
Indice = "A"
Debug.Print "Indice non existant- Indice passe à:" + Indice
Debug.Print "OldIndice:" & OldIndice
Else
Indice = Chr$(Asc(Indice) + 1)
Debug.Print "Indice:" + Indice
Debug.Print "OldIndice:" & OldIndice
End If
Set fso = VBA.CreateObject("Scripting.FileSystemObject")
path = Filepath + Compteur + Indice + Extension
Debug.Print "Path:"; path
'On vérifie que l'indice que l'on veux créer n'existe pas déjà
If Dir(path) <> "" Then
MsgBox "Le fichier " & path & " existe déjà. Création de cet Indice refusé."
End
End If
'on modifie les propriétées Indice et Nom_Fichier
Set swCustProp = swModel.Extension.CustomPropertyManager("")
bRet = swCustProp.Add3("Indice", swCustomInfoType_e.swCustomInfoText, Indice, swCustomPropertyAddOption_e.swCustomPropertyDeleteAndAdd)
Debug.Print "Propriété Indice:" & Indice
bRet = swCustProp.Add3("Nom_Fichier", swCustomInfoType_e.swCustomInfoText, Compteur + Indice, swCustomPropertyAddOption_e.swCustomPropertyDeleteAndAdd)
'Debug.Print "Propriété Nom_Fichier:" & Compteur + Indice
'On enregistre la nouvelle pièce ou assemblage
swModel.SaveAs3 "" & path & "", 0, 0
'On vérifie l'existance de la MEP associé
PathMep = Filepath + Compteur
Debug.Print Filepath + Compteur & OldIndice; ".SLDDRW"
If Dir(PathMep & OldIndice & ".SLDDRW") <> "" Then
Call fso.CopyFile(PathMep & OldIndice & ".SLDDRW", PathMep & Indice & ".SLDDRW")
Set swApp = Application.SldWorks
'On change la référence du nouveau plan par la pièce ou assemblage avec le nouvel Indice
Call swApp.ReplaceReferencedDocument(PathMep & Indice & ".SLDDRW", PathMep & OldIndice & Extension, PathMep & Indice & Extension)
Else
Debug.Print "Pas de Mep"
End If
End Function
Eine weitere bewährte Methode besteht aus den gleichen Gründen darin, Zeichenfolgen (und andere wiederkehrende Werte) einer Konstante zuzuweisen und diese Konstante im Code zu verwenden, in diesem Fall die Dateierweiterung ".SLDDRW" mit z. B. Const SLDDRW As String = ".SLDDRW"
Dies ergibt Folgendes:
Const SLDDRW As String = ".SLDDRW"
Function incrementationIndicePlan()
Debug.Print " Function incrementationIndicePlan lancé"
'on vérifie si un indice est existant et on sauvegarde l'ancien
OldIndice = Indice
Debug.Print "OldIndice:" & OldIndice
'Maj 2023-06-12 Si Indice = " " on force l'Indice pour avoir la valeur A
If Indice = vbNullString Or Indice = " " Then
Indice = "A"
Debug.Print "Indice non existant- Indice passe à:" + Indice
Debug.Print "OldIndice:" & OldIndice
Else
Indice = Chr$(Asc(Indice) + 1)
Debug.Print "Indice:" + Indice
Debug.Print "OldIndice:" & OldIndice
End If
Set fso = VBA.CreateObject("Scripting.FileSystemObject")
path = Filepath + Compteur + Indice + Extension
Debug.Print "Path:"; path
'On vérifie que l'indice que l'on veux créer n'existe pas déjà
If Dir(path) <> vbNullString Then
MsgBox "Le fichier " & path & " existe déjà. Création de cet Indice refusé."
End
End If
'on modifie les propriétées Indice et Nom_Fichier
Set swCustProp = swModel.Extension.CustomPropertyManager(vbNullString)
bRet = swCustProp.Add3("Indice", swCustomInfoType_e.swCustomInfoText, Indice, swCustomPropertyAddOption_e.swCustomPropertyDeleteAndAdd)
Debug.Print "Propriété Indice:" & Indice
bRet = swCustProp.Add3("Nom_Fichier", swCustomInfoType_e.swCustomInfoText, Compteur + Indice, swCustomPropertyAddOption_e.swCustomPropertyDeleteAndAdd)
'Debug.Print "Propriété Nom_Fichier:" & Compteur + Indice
'On enregistre la nouvelle pièce ou assemblage
swModel.SaveAs3 vbNullString & path & vbNullString, 0, 0
'On vérifie l'existance de la MEP associé
PathMep = Filepath + Compteur
Debug.Print Filepath + Compteur & OldIndice; SLDDRW
If Dir(PathMep & OldIndice & SLDDRW) <> vbNullString Then
Call fso.CopyFile(PathMep & OldIndice & SLDDRW, PathMep & Indice & SLDDRW)
Set swApp = Application.SldWorks
'On change la référence du nouveau plan par la pièce ou assemblage avec le nouvel Indice
Call swApp.ReplaceReferencedDocument(PathMep & Indice & SLDDRW, PathMep & OldIndice & Extension, PathMep & Indice & Extension)
Else
Debug.Print "Pas de Mep"
End If
End Function