Hello
I'd like to make a macro to isolate in an assembly (by going through the whole tree) only the parts that contain the custom property in a " REF-PIECE " part and that it is different from empty.
Is it possible? And do you have any idea how to do that?
chatGPT generated this code for me, it works. But I find it slow, you have to.
20sec for an assembly that doesn't have too many parts though. Do you see something in the code that could be optimized to go much faster?
Option Explicit
Const swDocPART = 1
Const swDocASSEMBLY = 2
Const swDocDRAWING = 3
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swAssy As SldWorks.AssemblyDoc
Dim componentsToSelect As Collection
Dim processedComponents As Object ' Dictionnaire pour suivre les composants traités
Sub main()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
If swModel Is Nothing Then
MsgBox "Aucun document actif."
Exit Sub
End If
If swModel.GetType <> swDocASSEMBLY Then
MsgBox "Ce script fonctionne uniquement dans un assemblage."
Exit Sub
End If
Set swAssy = swModel
Set componentsToSelect = New Collection
Set processedComponents = CreateObject("Scripting.Dictionary") ' Utilisation d'un dictionnaire pour une recherche rapide
' Récupère le composant racine
Dim rootComp As SldWorks.Component2
Set rootComp = swModel.ConfigurationManager.ActiveConfiguration.GetRootComponent3(True)
If rootComp Is Nothing Then
MsgBox "Composant racine introuvable."
Exit Sub
End If
' Appel du parcours
Call ParcourirComposants(rootComp)
' Sélection des pièces avec REF-PIECE non vide
swModel.ClearSelection2 True
Dim comp As SldWorks.Component2
' Création de la sélection multiple
For Each comp In componentsToSelect
comp.Select4 True, Nothing, False
Next comp
' Si des pièces ont été sélectionnées, on les isole
If componentsToSelect.Count > 0 Then
swApp.SendMsgToUser2 "Isoler les pièces trouvées.", swMessageBoxIcon_e.swMbInformation, swMessageBoxBtn_e.swMbOk
' Isoler avec SendKeys
SendKeys "i"
Else
MsgBox "Aucune pièce avec la propriété de configuration 'REF-PIECE' trouvée."
End If
End Sub
Sub ParcourirComposants(compParent As SldWorks.Component2)
Dim vChildComp As Variant
Dim swChild As SldWorks.Component2
Dim i As Integer
Dim swModelChild As ModelDoc2
Dim swConf As SldWorks.Configuration
Dim val As String
Dim compKey As String
Dim fileName As String
Dim confName As String
If compParent Is Nothing Then Exit Sub
' Récupérer les composants enfants
vChildComp = compParent.GetChildren
' Vérification : Si des enfants existent
If Not IsEmpty(vChildComp) Then
' On parcourt le tableau des enfants
For i = 0 To UBound(vChildComp)
Set swChild = vChildComp(i)
If Not swChild.IsSuppressed Then
If swChild.GetModelDoc2 Is Nothing Then
swChild.ReferencedConfiguration = swChild.ReferencedConfiguration ' Force le chargement
End If
Set swModelChild = swChild.GetModelDoc2
' Optimisation : Vérifie d'abord si le modèle est déjà chargé
If Not swModelChild Is Nothing Then
' Vérification que le type de modèle est une pièce
If swModelChild.GetType = swDocPART Then
confName = swChild.ReferencedConfiguration
Set swConf = swModelChild.GetConfigurationByName(confName)
If Not swConf Is Nothing Then
val = swConf.CustomPropertyManager.Get("REF-PIECE")
' Si la propriété REF-PIECE n'est pas vide
If Len(Trim(val)) > 0 Then
fileName = GetFileNameFromPath(swChild.GetPathName) ' Extraire le nom du fichier
compKey = fileName & "-" & confName ' Créer la clé unique avec le nom de fichier et la configuration
' Si la clé n'existe pas déjà dans le dictionnaire, on l'ajoute
If Not processedComponents.Exists(compKey) Then
componentsToSelect.Add swChild
processedComponents.Add compKey, True ' Ajoute la clé au dictionnaire
End If
End If
End If
End If
End If
End If
' Appel récursif sur les sous-enfants
Call ParcourirComposants(swChild)
Next i
End If
End Sub
' Fonction pour extraire le nom du fichier depuis le chemin
Function GetFileNameFromPath(filePath As String) As String
Dim fileName As String
fileName = Mid(filePath, InStrRev(filePath, "\") + 1)
GetFileNameFromPath = fileName
End Function
Hello
What I would do is declare all the variables that are in the For loop before the loop (in other words, output all the lines with a Dim). They don't need to be redeclared at each iteration, as long as their value is reassigned in the loop.
I'm not saying that it will speed up much but it's better for the cpu.
Hello, thank you for your answer, I just made the change (I modified the code of my basic message accordingly). I didn't see any time saved unfortunately 
If it's not of interest to you, you can comment on the recursive call on sub-children. With an apostrophe in front of Call.
' Appel récursif sur les sous-enfants
' Call ParcourirComposants(swChild)
You can try with a With block, but I don't know if Solidworks handles it anymore
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swAssy As SldWorks.AssemblyDoc
Dim componentsToSelect As Collection
Dim processedComponents As Object ' Dictionnaire pour suivre les composants traités
Sub main()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
If swModel Is Nothing Then
MsgBox "Aucun document actif."
Exit Sub
End If
If swModel.GetType <> swDocASSEMBLY Then
MsgBox "Ce script fonctionne uniquement dans un assemblage."
Exit Sub
End If
Set swAssy = swModel
Set componentsToSelect = New Collection
Set processedComponents = CreateObject("Scripting.Dictionary") ' Utilisation d'un dictionnaire pour une recherche rapide
' Récupère le composant racine
Dim rootComp As SldWorks.Component2
Set rootComp = swModel.ConfigurationManager.ActiveConfiguration.GetRootComponent3(True)
If rootComp Is Nothing Then
MsgBox "Composant racine introuvable."
Exit Sub
End If
' Appel du parcours
Call ParcourirComposants(rootComp)
' Sélection des pièces avec REF-PIECE non vide
swModel.ClearSelection2 True
Dim comp As SldWorks.Component2
' Création de la sélection multiple
For Each comp In componentsToSelect
comp.Select4 True, Nothing, False
Next comp
' Si des pièces ont été sélectionnées, on les isole
If componentsToSelect.Count > 0 Then
swApp.SendMsgToUser2 "Isoler les pièces trouvées.", swMessageBoxIcon_e.swMbInformation, swMessageBoxBtn_e.swMbOk
' Isoler avec SendKeys
SendKeys "i"
Else
MsgBox "Aucune pièce avec la propriété de configuration 'REF-PIECE' trouvée."
End If
End Sub
Sub ParcourirComposants(compParent As SldWorks.Component2)
Dim vChildComp As Variant
Dim swChild As SldWorks.Component2
Dim i As Integer
Dim swModelChild As ModelDoc2
Dim swConf As SldWorks.Configuration
Dim val As String
Dim compKey As String
Dim fileName As String
Dim confName As String
If compParent Is Nothing Then Exit Sub
' Récupérer les composants enfants
vChildComp = compParent.GetChildren
' Vérification : Si des enfants existent
If Not IsEmpty(vChildComp) Then
' On parcourt le tableau des enfants
For i = 0 To UBound(vChildComp)
Set swChild = vChildComp(i)
With swChild
If Not .IsSuppressed Then
If .GetModelDoc2 Is Nothing Then
.ReferencedConfiguration = .ReferencedConfiguration ' Force le chargement
End If
Set swModelChild = .GetModelDoc2
' Optimisation : Vérifie d'abord si le modèle est déjà chargé
If Not swModelChild Is Nothing Then
' Vérification que le type de modèle est une pièce
If swModelChild.GetType = swDocPART Then
confName = .ReferencedConfiguration
Set swConf = swModelChild.GetConfigurationByName(confName)
If Not swConf Is Nothing Then
val = swConf.CustomPropertyManager.Get("REF-PIECE")
' Si la propriété REF-PIECE n'est pas vide
If Len(Trim(val)) > 0 Then
fileName = GetFileNameFromPath(.GetPathName) ' Extraire le nom du fichier
compKey = fileName & "-" & confName ' Créer la clé unique avec le nom de fichier et la configuration
' Si la clé n'existe pas déjà dans le dictionnaire, on l'ajoute
If Not processedComponents.Exists(compKey) Then
componentsToSelect.Add swChild
processedComponents.Add compKey, True ' Ajoute la clé au dictionnaire
End If
End If
End If
End If
End If
End If
End With
' Appel récursif sur les sous-enfants
Call ParcourirComposants(swChild)
Next i
End If
End Sub
' Fonction pour extraire le nom du fichier depuis le chemin
Function GetFileNameFromPath(filePath As String) As String
Dim fileName As String
fileName = Mid(filePath, InStrRev(filePath, "\") + 1)
GetFileNameFromPath = fileName
End Function
Note: Be careful, I have left recursion active on this code.
Alternatively, you can also put breakpoints (in the column to the left of the macro editor's row number) in key places to determine which portions of the code are the most time-consuming. Just to know what to work on.
In a 1st step, I would place a breakpoint in front of the line that follows the line of the beginning of the For loop (in other words, in front of the line Set swChild = vChildComp(i)). This will allow you, during the runtime, to know when the loop and each new iteration start, and thus to evaluate/measure how much time passes between 2 iterations.
The code seems to me to be well designed and rather well constituted and optimized. (For a cat that's pretty good, I have to admit!)
On an assembly of 2296 parts with 339 unique parts file time about 20s (without any parts with the REF-PIECE property specified.)
On an assembly with 152 parts for 142 single parts time 2-3 s max (without any parts with the property to be insulated)
This seems pretty correct to me given that it goes through all the sets and subsets.
On the other hand, be careful to launch your code only on resolved assemblies otherwise it may not isolate you from some unresolved components, if I'm not mistaken.
For the isolation part, you should avoid running shortcuts in a macro (don't execute anything if the shortcut on the workstation is not installed (or worse execute something else if the shortcut is used for something else!)
Replace:
' Isoler avec SendKeys
SendKeys "i"
By:
Dim status As Boolean
status = swModel.Isolate()
swModel.SetIsolateVisibility (swIsolateVisibility_e.swIsolateVisibility_HIDDEN) 'swIsolateVisibility_HIDDEN swIsolateVisibility_TRANSPARENT swIsolateVisibility_WIREFRAME
'Exit isolate
'status = swModel.ExitIsolate() 'Pour suppression éventuel de la fonction isolé (à déplacer ou rajouter du code entre isolé et suppression isolé)
Ability to choose something other than hidden from the isolated options (HIDDEN, TRANSPARENT or WIREFRAME)
Hello
Thank you for your answers.
To isolate it, it would be possible to display this window as when you manually isolate to exit it quickly, with the swModel.SetIsolateVisibility (swIsolateVisibility_e.swIsolateVisibility_HIDDEN)
I don't think you can display a button in the macro that launches the code to exit isolate:
status = swModel.ExitIsolate()
See the attached macro with the addition of the button.
Isolate-Prop.swp (70.5 KB)
For the userform display code:
' Isoler avec SendKeys
'SendKeys "i"
Dim status As Boolean
status = swModel.Isolate()
swModel.SetIsolateVisibility (swIsolateVisibility_e.swIsolateVisibility_HIDDEN) 'swIsolateVisibility_HIDDEN swIsolateVisibility_TRANSPARENT swIsolateVisibility_WIREFRAME
'Exit isolate
'status = swModel.ExitIsolate()
UserformQuitter.Show vbModeless
And for the code of UserformQuitter (with a button named Button1)
It's perfect, it's exactly what I needed. 
Would it be possible for this userform to be centered in the SW window to find it easily, because it is a little bit everywhere 
depending on the user if there are 1 or 2 or 3 screens. I tried a trick to center that I had for a userform on excel but it doesn't work here.
Hello
You need to add a procedure in the code, see this topic: Centering a userform on a screen - Macro - myCAD Forum
No, what works on Excel does not work on SW.
To center the window in relation to the screen used is very complicated on SW.
See this topic and @m_blt's answer once again:
forum.mycad.visiativ.com/t/centrer-un-userform-sur-un-ecran/108560?lang=fr
Thank you, I just looked at the subject. I have applied what must be done. it works well for the userformLeaves it is well centered. I did the same thing for my 2nd userformChoix but there it doesn't work it tells me that it can't find the window to be able to center. Do you know what would have to be changed?
Insulate room without hardware.swp (117.5 KB)
Hello
For my part, I put the function call in each userform in the activate procedure:
Private Sub UserForm_Activate()
CoincidentsCtresWindows "SOLIDWORKS", xxx.Caption, True
End Sub
it's perfect, it works, thank you 