Bonjour,
j’aimerais faire une macro pour isoler dans un assemblage (en parcourant tout l’arbre) uniquement les pièces qui contienne la propriété personnalisé dans une pièce « REF-PIECE » et qu’elle soit différente de vide.
est-ce que c’est possible ? et est-ce que vous auriez une idée de comment faire ça ?
chatGPT m’a généré ce code, ça fonctionne. Mais je trouve ça lent il faut
20sec pour un assemblage qui n’a pas trop de pièce pourtant. Est-ce que vous voyez un truc dans le code qui pourrait être optimiser pour aller beaucoup plus vite ?
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
Bonjour
Ce que je ferais c’est de déclarer toutes les variables qui sont dans la boucle For avant la boucle (en clair, sortir toutes les lignes avec un Dim). Elles n’ont pas besoin d’être redéclarées à chaque itération, tant que leur valeur est réaffectée dans la boucle.
Je ne dis pas que ça accélèrera beaucoup mais c’est mieux pour le cpu.
Bonjour, merci pour votre réponse, je viens de faire le changement (j’ai modifier le code de mon message de base en conséquent). je n’ai vu aucun gain de temps malheureusement 
Si ça ne présente pas d’intérêt pour toi, tu peux mettre en commentaire l’appel récursif sur les sous-enfants. Avec une apostrophe devant Call.
' Appel récursif sur les sous-enfants
' Call ParcourirComposants(swChild)
Tu peux essayer avec un bloc With, mais je ne sais plus si Solidworks le gère
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: Attention, j’ai laissé la récursivité active sur ce code.
Sinon, tu peux aussi mettre des points d’arrêt (dans la colonne à gauche du numéro de ligne de l’éditeur de macro) à des endroits clés pour déterminer quelles portions du code sont les plus chronophages. Histoire de savoir sur quoi travailler.
Dans un 1er temps, je placerais un point d’arrêt devant la ligne qui suit la ligne du début de la boucle For (en clair, devant la ligne Set swChild = vChildComp(i)). Cela te permettra, pendant l’exécution, de savoir quand la boucle et chaque nouvelle itération débutent, et ainsi d’évaluer/mésurer combien de temps il se passe entre 2 itérations.
Le code me semble bien conçu et plutôt bien constitué et optimisé. (Pour un chat c’est plutôt bien, il faut l’avouer!)
Sur un assemblage de 2296 pièces avec 339 fichier de pièces uniques temps environ 20s (sans aucune pièce avec la propriété REF-PIECE de renseigné.)
Sur un assemblage avec 152 pièces pour 142 pièces unique temps 2-3 s max (sans aucune pièce avec la propriété à isoler)
Cela me semble plutôt correct étant donnée qu’il parcours tous les ensemble et sous ensemble.
Par contre attention à bien lancer ton code uniquement sur des assemblage résolu sans quoi cela risque de ne pas t’isoler certain composant non résolu, si je me trompe pas.
Pour la partie isoler il faut éviter de lancer des raccourcis dans une macro (n’execute rien si le raccourcis sur le poste n’est pas installé (ou pire exécute autre chose si le raccourcis sert à autre chose!)
Remplacer:
' Isoler avec SendKeys
SendKeys "i"
Par:
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é)
Possibilité de choisir autre chose que caché dans les options de isolé (HIDDEN, TRANSPARENT ou WIREFRAME)
Bonjour,
merci pour vos réponses.
pour le isoler, il serait possible d’afficher cette fenêtre comme quand on isole manuellement pour le quitter rapidement, avec le swModel.SetIsolateVisibility (swIsolateVisibility_e.swIsolateVisibility_HIDDEN)
Je ne pense pas en revanche tu peux afficher un bouton dans la macro qui lance le code pour quitter isoler:
status = swModel.ExitIsolate()
Voir la macro jointe avec ajout du bouton.
Isoler-Prop.swp (70,5 Ko)
Pour le code d’affichage du userform:
' 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
Et pour le code de UserformQuitter (avec un bouton nommé Button1)
c’est parfait, c’est exactement ce qu’il me fallait. 
Est-ce qu’il serait possible que ce userform soit centré dans la fenêtre SW pour le trouvé facilement, car il ce met un peut partout en fonction des utilisateur s’il y a 1 ou 2 ou 3 écran. j’ai essayer un truc pour centrer que j’avais pour un userform sur excel mais ça ne fonctionne pas ici.
Bonjour,
Faut rajouter une procédure dans le code, voir ce sujet : Centrer un userform sur un écran - Macro - Forum myCAD
Non, ce qui marche sur Excel ne fonctionne pas sur SW.
Pour centrer la fenêtre par rapport à l’écran utilisé c’est très compliqué sur SW.
Voir ce sujet et la réponse de @m_blt une fois de plus:
Merci, je viens de regarder le sujets. j’ai appliqué ce qu’il faut faire. ça fonctionne bien pour le userformQuitte il est bien centré. j’ai fais la même chose pour mon 2ème userformChoix mais là ca ne fonctionne pas il me dit qu’il trouve pas la fenêtre pour pouvoir centré. est-ce que vous savez ce qu’il y aurait à modifier ?
Isoler pièce sans quincaillerie.swp (117,5 Ko)
Bonjour,
Pour ma part, j’ai mis l’appel à la fonction dans chaque userform dans la procédure activate:
Private Sub UserForm_Activate()
CoincidentsCtresWindows "SOLIDWORKS", xxx.Caption, True
End Sub
c’est parfait ça fonctionne merci 