After using " CircuitwWorks ", I get an assembly made up of several parts. These are taken from a " Components " folder.
In addition, I have another independent directory " Database " in which other parts are located.
Do you know if there is a way via a macro to replace the parts of the assembly from the Components folder with those from the Database folder?
To help with identification and replacement, the share names used in Components and Database are similar (but not identical): for example, " Foo-xxx-123-abs.SLDPRT " should be replaced with " Toto_. SLDPRT ".
The image in pieces is perhaps more telling...
We have a macro start here, but maybe it's not the right start?
In your case, the macro that comes closest to your need is this one:
' 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
