Hallo
Ich möchte ein Makro erstellen, um in einer Baugruppe (indem ich den gesamten Baum durchlaufe) nur die Teile zu isolieren, die die benutzerdefinierte Eigenschaft in einem " REF-PIECE " -Teil enthalten und dass es sich von leer unterscheidet.
Ist es möglich? Und haben Sie eine Idee, wie man das macht?
chatGPT hat diesen Code für mich generiert, er funktioniert. Aber ich finde es langsam, das muss man.
20 Sekunden für eine Baugruppe, die nicht zu viele Teile enthält. Sehen Sie etwas im Code, das optimiert werden könnte, um viel schneller zu werden?
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
Hallo
Was ich tun würde, ist, alle Variablen, die sich in der For-Schleife befinden, vor der Schleife zu deklarieren (mit anderen Worten, alle Zeilen mit einem Dim auszugeben). Sie müssen nicht bei jeder Iteration neu deklariert werden, solange ihr Wert in der Schleife neu zugewiesen wird.
Ich sage nicht, dass es viel schneller wird, aber es ist besser für die CPU.
Hallo, danke für Ihre Antwort, ich habe gerade die Änderung vorgenommen (ich habe den Code meiner Basisnachricht entsprechend geändert). Ich habe leider keine Zeitersparnis gesehen 
Wenn es für Sie nicht von Interesse ist, können Sie den rekursiven Aufruf auf untergeordnete Kinder kommentieren. Mit einem Apostroph vor Call.
' Appel récursif sur les sous-enfants
' Call ParcourirComposants(swChild)
Sie können es mit einem With-Block versuchen, aber ich weiß nicht, ob Solidworks damit noch umgehen kann
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
Hinweis: Seien Sie vorsichtig, ich habe die Rekursion in diesem Code aktiv gelassen.
Alternativ können Sie auch Haltepunkte (in der Spalte links neben der Zeilennummer des Makro-Editors) an wichtigen Stellen einfügen, um zu bestimmen, welche Teile des Codes am zeitaufwändigsten sind. Nur um zu wissen, woran man arbeiten muss.
In einem 1. Schritt würde ich einen Breakpoint vor der Zeile platzieren, der der Zeile des Anfangs der For-Schleife folgt (mit anderen Worten, vor der Zeile Set swChild = vChildComp(i)). Auf diese Weise können Sie während der Laufzeit wissen, wann die Schleife und jede neue Iteration beginnt, und somit auswerten/messen, wie viel Zeit zwischen 2 Iterationen vergeht.
Der Code scheint mir gut gestaltet und ziemlich gut konstituiert und optimiert zu sein. (Für eine Katze ist das ziemlich gut, muss ich zugeben!)
Bei einer Baugruppe von 2296 Teilen mit 339 eindeutigen Bauteilen dauert die Dateidatei ca. 20 s (ohne Teile, für die die Eigenschaft REF-PIECE angegeben ist).
Auf einer Baugruppe mit 152 Teilen für 142 Einzelteile Zeit max. 2-3 s (ohne Teile mit der Eigenschaft zu isolieren)
Das scheint mir ziemlich richtig zu sein, wenn man bedenkt, dass es alle Sätze und Teilmengen durchläuft.
Achten Sie andererseits darauf, Ihren Code nur für aufgelöste Assemblys zu starten, da Sie sonst möglicherweise nicht von einigen nicht aufgelösten Komponenten isoliert werden, wenn ich mich nicht irre.
Für den Isolationsteil sollten Sie das Ausführen von Verknüpfungen in einem Makro vermeiden (führen Sie nichts aus, wenn die Verknüpfung auf der Workstation nicht installiert ist (oder schlimmer noch, führen Sie etwas anderes aus, wenn die Verknüpfung für etwas anderes verwendet wird!)
Ersetzen:
' Isoler avec SendKeys
SendKeys "i"
Bis:
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é)
Möglichkeit, aus den isolierten Optionen (HIDDEN, TRANSPARENT oder WIREFRAME) etwas anderes als HIDDEN auszuwählen
Hallo
Vielen Dank für Ihre Antworten.
Um es zu isolieren, wäre es möglich, dieses Fenster so anzuzeigen, wie wenn Sie es manuell isolieren, um es schnell zu verlassen, mit der Schaltfläche swModel.SetIsolateVisibility (swIsolateVisibility_e.swIsolateVisibility_HIDDEN)
Ich glaube nicht, dass Sie eine Schaltfläche im Makro anzeigen können, die den Code zum Beenden der Isolierung startet:
status = swModel.ExitIsolate()
Sehen Sie sich das angehängte Makro mit dem Zusatz der Schaltfläche an.
Isolate-Prop.swp (70.5 KB)
Für den Anzeigecode des Benutzerformulars:
' 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
Und für den Code von UserformQuitter (mit einer Schaltfläche namens Button1)
Es ist perfekt, es ist genau das, was ich brauchte. 
Wäre es möglich, dass dieses Benutzerformular im SW-Fenster zentriert wird, um es leicht zu finden, da es je nach Benutzer ein wenig überall ist, ob es 1 oder 2 oder 3 Bildschirme gibt. Ich habe einen Trick zum Zentrieren ausprobiert, den ich für ein Benutzerformular in Excel hatte, aber es funktioniert hier nicht.
Hallo
Sie müssen eine Prozedur im Code hinzufügen, siehe dieses Thema: Zentrieren eines Benutzerformulars auf einem Bildschirm - Makro - myCAD Forum
Nein, was in Excel funktioniert, funktioniert nicht in SW.
Das Fenster in Bezug auf den verwendeten Bildschirm zu zentrieren, ist auf SW sehr kompliziert.
Sehen Sie sich dieses Thema und die Antwort von @m_blt noch einmal an:
Danke, ich habe mir das Thema gerade angeschaut. Ich habe angewendet, was getan werden muss. Es funktioniert gut für die userformLeaves, es ist gut zentriert. Ich habe das Gleiche für meinen 2. Benutzer gemacht, aber dort funktioniert es nicht, es sagt mir, dass es das Fenster nicht finden kann, um es zentrieren zu können. Wissen Sie, was geändert werden müsste?
Raum ohne Hardware isolieren.swp (117.5 KB)
Hallo
Ich für meinen Teil habe den Funktionsaufruf in jedem Benutzerformular in die Aktivierungsprozedur eingefügt:
Private Sub UserForm_Activate()
CoincidentsCtresWindows "SOLIDWORKS", xxx.Caption, True
End Sub
Es ist perfekt, es funktioniert, danke 