Na het gebruik van " CircuitwWorks " krijg ik een assemblage die uit verschillende onderdelen bestaat. Deze zijn afkomstig uit een map " Componenten ".
Daarnaast heb ik nog een onafhankelijke directory " Database " waarin andere delen zich bevinden.
Weet je of er een manier is om via een macro de onderdelen van de assembly uit de map Componenten te vervangen door die uit de map Database?
Om te helpen bij het identificeren en vervangen, zijn de sharenamen die worden gebruikt in Components en Database vergelijkbaar (maar niet identiek): bijvoorbeeld " Foo-xxx-123-abs.SLDPRT " moet worden vervangen door " Toto_. SLDPRT ".
Het beeld in stukjes is misschien veelzeggender...
We hebben hier een macro-start, maar misschien is het niet de juiste start?
In uw geval is de macro die het dichtst bij uw behoefte komt deze:
' 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