Nach der Verwendung von " CircuitwWorks " erhalte ich eine Baugruppe, die aus mehreren Teilen besteht. Diese werden aus einem " Components " -Ordner entnommen.
Darüber hinaus habe ich ein weiteres unabhängiges Verzeichnis " Datenbank ", in dem sich andere Teile befinden.
Wissen Sie, ob es eine Möglichkeit gibt, über ein Makro die Teile der Baugruppe aus dem Ordner Komponenten durch die Teile aus dem Ordner Datenbank zu ersetzen?
Um die Identifizierung und den Austausch zu erleichtern, sind die in Komponenten und Datenbank verwendeten Freigabenamen ähnlich (aber nicht identisch): Zum Beispiel sollte " Foo-xxx-123-abs.SLDPRT " durch " Toto_ ersetzt werden. SLDPRT ".
Das Bild in Stücken ist vielleicht aussagekräftiger...
Wir haben hier einen makroökonomischen Start, aber vielleicht ist es nicht der richtige Start?
In Ihrem Fall ist das Makro, das Ihren Anforderungen am nächsten kommt, dieses:
' Définition du répertoire contenant les fichiers de remplacement
Const REPLACEMENT_DIR As String = "D:\Assembly\Replacement"
' Définition du suffixe qui sera ajouté au nom du fichier de remplacement
Const SUFFIX As String = "_new"
' Déclaration de l’objet principal SolidWorks
Dim swApp As SldWorks.SldWorks
Sub main()
' Récupère l’instance de l’application SolidWorks active
Set swApp = Application.SldWorks
Dim swModel As SldWorks.ModelDoc2
' Récupère le document SolidWorks actuellement actif (pièce, assemblage ou mise en plan)
Set swModel = swApp.ActiveDoc
' Vérifie qu’un document est bien ouvert
If Not swModel Is Nothing Then
' Convertit le document actif en document d’assemblage
Dim swAssy As SldWorks.AssemblyDoc
Set swAssy = swModel
' Accède au gestionnaire de sélection pour récupérer les objets sélectionnés
Dim swSelMgr As SldWorks.SelectionMgr
Set swSelMgr = swModel.SelectionManager
Dim i As Integer
' Parcourt chaque objet actuellement sélectionné dans l’assemblage
For i = 1 To swSelMgr.GetSelectedObjectCount2(-1)
' Vérifie si l’objet sélectionné est bien un composant d’assemblage
If swSelMgr.GetSelectedObjectType3(i, -1) = swSelectType_e.swSelCOMPONENTS Then
' Déclaration et récupération du composant sélectionné
Dim swComp As SldWorks.Component2
Set swComp = swSelMgr.GetSelectedObject6(i, -1)
' Suspend la gestion de la liste de sélection pour éviter les interférences
Debug.Print swSelMgr.SuspendSelectionList
' Ajoute explicitement le composant à la liste de sélection
swSelMgr.AddSelectionListObject swComp, Nothing
' Remplace le composant sélectionné par son équivalent dans le dossier de remplacement
' La fonction GetReplacementPath crée le chemin du nouveau fichier
swAssy.ReplaceComponents2 GetReplacementPath(swComp), swComp.ReferencedConfiguration, False, swReplaceComponentsConfiguration_e.swReplaceComponentsConfiguration_MatchName, True
' Réactive la gestion de la sélection une fois le remplacement effectué
swSelMgr.ResumeSelectionList
End If
Next
Else
' Message d’erreur si aucun assemblage n’est ouvert
MsgBox ("Veuillez ouvrir un document d’assemblage avant d’exécuter la macro")
End If
End Sub
' Fonction utilitaire : génère le chemin complet du fichier de remplacement
Function GetReplacementPath(comp As SldWorks.Component2)
Dim replFilePath As String
Dim compPath As String
compPath = comp.GetPathName() ' Récupère le chemin complet du composant d’origine
Dim dir As String
dir = REPLACEMENT_DIR ' Dossier de remplacement prédéfini
' Ajoute un "\" à la fin du chemin si nécessaire
If Right(dir, 1) <> "\" Then
dir = dir & "\"
End If
' Extrait uniquement le nom du fichier (sans le chemin)
Dim fileName As String
fileName = Right(compPath, Len(compPath) - InStrRev(compPath, "\"))
' Si un suffixe est défini, on le rajoute avant l’extension du fichier
If SUFFIX <> "" Then
Dim ext As String
' Suppose que tous les fichiers ont une extension de type .SLDxxx (ex : .SLDPRT, .SLDASM)
ext = Right(fileName, Len(".SLDXXX"))
' Insertion du suffixe avant l’extension
fileName = Left(fileName, Len(fileName) - Len(ext)) & SUFFIX & ext
End If
' Construit le chemin complet du fichier de remplacement
replFilePath = dir & fileName
' Retourne le chemin généré à la fonction appelante
GetReplacementPath = replFilePath
End Function
