Macro om delen van een assemblage massaal te vervangen door naamequivalentie?

Hallo mensen

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?

Bij voorbaat dank en een fijne dag!

Gwen.

Hallo

Als er geen macro nodig is, is er een manier om de componenten te vervangen via het componentcontextmenu in de featureManager.

Selecteer alle identieke onderdelen > klik met de rechtermuisknop op een van de geselecteerde elementen > Onderdelen vervangen.

Herhaal dit voor elk afzonderlijk onderdeel.

Hallo Sylk,

Bedankt voor je feedback!

Het probleem is dat deze actie vele malen kan worden herhaald... Misschien zelfs voorbij de 100, dus heel lang :open_mouth:

1 like

Hallo;

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

(Originele macro:)

Basisfunctie:
https://help.solidworks.com/2017/english/api/sldworksapi/solidworks.interop.sldworks~solidworks.interop.sldworks.iassemblydoc~replacecomponents2.html

Met een paar minimale wijzigingen zou u in staat moeten zijn om de gewenste vervangingen door te voeren.

Bedankt voor je feedback, ik zal het proberen!

Een prettig weekend

Gwen.