Hello
I would like to make a macro where I can add a piece of data in the feature manager filter (1):
And if possible, check if zone 2 is empty or not after the filter.
If empty, the filter is removed.
If not empty msgbox
The most important thing is to be able to add or remove a piece of data from the filter, the verification (life or not empty) would remain secondary.
I found this function without really having an example:
If anyone has an example or idea of how to use this function.
Bonjour;
Bah, comme souvent il y a CodeStack: (Non testé)
I saw this code but for me it doesn't use the filter and on large assemblies like me, I think the search will be much slower.
If I really have no choice I'd go for it.
But our solution via the filter seems very fast by typing it by hand?
I just want to automate this search by integrating it into another macro.
And if possible then add the search once filtered if=0 no message and if >0 message
Technically the use of the fitre looks like this:
Sub FiltrerFeatureManager()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim searchText As String
' Initialiser l'application SolidWorks
Set swApp = Application.SldWorks
' Obtenir le modèle actif
Set swModel = swApp.ActiveDoc
' Vérifier si un document est ouvert
If swModel Is Nothing Then
MsgBox "Aucun document ouvert."
Exit Sub
End If
' Définir le texte de recherche
searchText = "Rondelle"
' Définir le texte de filtrage dans le FeatureManager
swModel.Extension.FeatureManagerFilterString = searchText
' Forcer la mise à jour de l'interface utilisateur
swModel.GraphicsRedraw2
End Sub
It works, in this example, only the " washers " are filtered. Only there is a problem (and not the least), I can't manage to " cancel " the filtration...
I just tested this code step by step:
Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swModelDocExt As SldWorks.ModelDocExtension
Dim value As String
Dim value2 As String
Sub main()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swModelDocExt = swModel.Extension
value = "Tôle passage réduit"
'value = swModelDocExt.FeatureManagerFilterString
swModelDocExt.FeatureManagerFilterString = value
value2 = swModelDocExt.FeatureManagerFilterString
Debug.Print value2
swModelDocExt.FeatureManagerFilterString = ""
'swModel.ClearSelection2 True
End Sub
The filter applies to the graphics window (CAD part), only my filtered part appears in this graphic area.
On the other hand, the feature manager remains fixed. (complete tree structure of the assembly and nothing apparent in the filter.
Bug in my 2023 SP05 version or normal behavior?
Or bad function?
@Maclane to cancel a filter you have to put " " in value or searchtext=" " for your code
Same behavior with your code:
Only the washers appear on the right.
But nothing in the feature manager.
Macro method:
Manual method:
under Solidworks 2022 the same observation, only the graphical view is impacted.
@sbadenis : at your place also the order:
searchtext=« »
Is incredibly slow?
I tried with:
searchtext= vbNullString
but it's not better...
Have you looked at the TreeManager side of the Mycad tools (it's hidden in the "reference tools" drop-down):
This obviously does not meet all your needs but it is also an option for multi-criteria filtration:
Note: I really have a hard time understanding the Visiativ logic which consists of hiding their tools, or even not installing them by default anymore... it does not encourage consumption...
there may be another possible path by going through The Advanced Selections.
(often forgotten option of Solidworks).
Some VBA examples are available in the API Helps:
https://help.solidworks.com/2022/english/api/sldworksapi/Use_Advanced_Component_Selection_Example_VB.htm?verRedirect=1
https://help.solidworks.com/2022/english/api/sldworksapi/solidworks.interop.sldworks~solidworks.interop.sldworks.iadvancedselectioncriteria.html
Edit: I just realized that this is the function used by the CodeStack macro mentioned above...
@Maclane Yes for me too it takes " 2 hours " to refresh the view!
For the use of TreeManager, not possible I want to add this in an existing macro.
If I go through an ext utility in SW the designers will not do it systematically and behind it generates errors parts to be replaced not detected.
For the limited number of utilities I think it's not due to Visiativ but Windows or Dassault I don't know, who created this limitation (Cf hotline)
For the advanced selection, I just tested it works for parts in the assembly but in a subassembly it no longer finds the part.
It seemed perfect!
Failing to find a reliable solution via APIs, I developed a macro.
It goes through the tree structure (with the sub-levels) and then exports an html report.
Here is the code for those who want it.
Option Explicit
'U:\Bibliothèque\Equipements\Encaisseuses\Picking\Spécifiques\MSG N°194-MSG COMPACT DUAL M3R2\1-Dessins\AS_111792.SLDASM
Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swConf As SldWorks.Configuration
Dim swRootComp As SldWorks.Component2
Dim k As Integer
Dim dictionary As Object
Dim Values As clsObject
Dim CompModel As ModelDoc2
Dim Ret As Boolean
Dim htmlPath As String
Sub main()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swConf = swModel.GetActiveConfiguration
Set swRootComp = swConf.GetRootComponent
Set dictionary = CreateObject("Scripting.Dictionary")
TraverseComponentRecherchePropriete swRootComp, 1
'Lecture du Dictionnaire:
Dim TestvaleurDico As Variant
'Debug.Print dictionary.count
If dictionary.count <> 0 Then
'Création du fichier html
Dim xFile As Integer
Dim S1 As String
xFile = FreeFile
'Emplacement de sauvegarde des options
htmlPath = Environ("USERPROFILE") & "\.Rapports_SW\"
'On vérifie si le dossier de sauvegarde existe sinon création de ce dossier
If Dir(htmlPath, vbDirectory + vbHidden) = "" Then
MkDir htmlPath
End If
Open htmlPath & "RapportIndiçage.html" For Output As xFile
Print #xFile, "<HTML>"
Print #xFile, "<HEAD>"
Print #xFile, "<TITLE>Liste fichiers</TITLE>"
Print #xFile, "</HEAD>"
Print #xFile, ""
Print #xFile, "<BODY TEXT=""#000000"" >"
Print #xFile, " <h1><B>Liste des fichiers indicés à remplacer</B> </h1>"
Print #xFile, "<BR><BR>"
For Each TestvaleurDico In dictionary.Keys
'<a href="file:///D:/doc/monfichier.pdf">monfichier</a>
Print #xFile, "Nom: " & TestvaleurDico & "-> Désignation: " & dictionary(TestvaleurDico).Designation
Print #xFile, "<BR><BR>"
Print #xFile, "Chemin: " & dictionary(TestvaleurDico).Chemin
Print #xFile, "<BR><BR>"
Next TestvaleurDico
Print #xFile, "<BR><BR>"
Print #xFile, "</BODY>"
Print #xFile, "</HTML>"
Close xFile
'Ouvre le fichier html
Ret = ShellExecute(0, "open", "RapportIndiçage.html", vbNullString, htmlPath, 1)
End If
Set TestvaleurDico = Nothing
Set dictionary = Nothing
End Sub
Sub TraverseComponentRecherchePropriete(swComp As SldWorks.Component2, nLevel As Long)
Dim vChildComp As Variant
Dim swModelComponent As SldWorks.ModelDoc2
Dim swChildComp As SldWorks.Component2
Dim swCompConfig As SldWorks.Configuration
Dim myBool As String
Dim sPadStr As String
Dim i As Long
Dim Part As SldWorks.ModelDoc2
Dim Propriete As String
For i = 0 To nLevel - 1
sPadStr = sPadStr + " "
Next i
vChildComp = swComp.GetChildren
Propriete = "Designation"
For i = 0 To UBound(vChildComp)
Set swChildComp = vChildComp(i)
Set swModelComponent = swChildComp.GetModelDoc
TraverseComponentRecherchePropriete swChildComp, nLevel + 1 'multi niveau
'Debug.Print "Name2 : " & swChildComp.Name2 & vbCrLf & "ReferencedConfiguration: " & swChildComp.ReferencedConfiguration
boucle "Designation", "", "", "", swModelComponent, swChildComp.ReferencedConfiguration, swChildComp
Next i
End Sub
Sub boucle(Propriete, proprieteTab, proprieteTab_Prop, t, swModelComponent, swChildCompRC, swChildComp)
If Not swModelComponent Is Nothing Then
'Debug.Print swModelComponent.GetCustomInfoValue("", Propriete)
Set CompModel = swChildComp.GetModelDoc2
If InStr(swModelComponent.GetCustomInfoValue("", Propriete), "Remplac") > 1 Then
Set Values = New clsObject
Values.Chemin = swChildComp.GetPathName()
'Values.Nom = swChildComp.Name2
Values.Designation = swModelComponent.GetCustomInfoValue("", Propriete)
If dictionary.Exists(CompModel.GetTitle) Then
Set dictionary(CompModel.GetTitle) = Values
Else
dictionary.Add CompModel.GetTitle, Values
End If
'Debug.Print swChildComp.Name2
'Debug.Print CompModel.GetTitle
'Debug.Print swChildComp.GetPathName()
'Debug.Print swModelComponent.GetCustomInfoValue("", Propriete)
End If
If InStr(swModelComponent.GetCustomInfoValue(swChildCompRC, Propriete), "Remplac") > 1 Then
Set Values = New clsObject
Values.Chemin = swChildComp.GetPathName()
'Values.Nom = swChildComp.Name2
Values.Designation = swModelComponent.GetCustomInfoValue(swChildCompRC, Propriete)
If dictionary.Exists(CompModel.GetTitle) Then
Set dictionary(CompModel.GetTitle) = Values
Else
dictionary.Add CompModel.GetTitle, Values
End If
'Debug.Print swChildComp.Name2
'Debug.Print swChildComp.GetPathName()
'Debug.Print swModelComponent.GetCustomInfoValue("", Propriete)
End If
End If
End Sub
'Public Chemin As String, Designation As String, Nom As String
Sub AddValues()
For k = 2 To 3
Set Values = New clsPerson
Values.Chemin = "Chemin"
Values.Designation = "Designation"
'Values.Nom = "Nom"
If dictCompany.Exists(k) Then
Set dictCompany(k) = Values
Else
dictCompany.Add k, Values
End If
Next k
End Sub
And the class module (To be named clsObject):
Public Chemin As String, Designation As String ', Nom As String
Thank you @Maclane for the proposals and the confirmation of the bug, which distracted me from my 1st idea.
In the end, the truth was elsewhere.
