Macro SW Feature manager Filter

Bonjour,
Je souhaiterais réaliser une macro ou je puisse ajouter une donnée dans le filtre du feature manager (1):


Et si possible vérifier si la zone 2 est vide ou pas après le filtre.
Si vide on supprime le filtre.
Si pas vide msgbox

Le plus important est de pouvoir ajouter ou enlever une donnée au filtre la vérification (vie ou pas vide) resterait secondaire.
J’ai bien trouvé cette fonction sans vraiment avoir d’exemple:


Si quelqu’un à un exemple ou une idée de comment utiliser cette fonction.

Bonjour ;
Bah, comme souvent il y a CodeStack : (Non testé)

1 « J'aime »

J’ai bien vu ce code mais pour moi il n’utilise pas le filtre et sur de gros assemblage comme c’est mon cas, je pense que la recherche sera beaucoup plus lente.
si vraiment pas le choix je partirais la dessus.
mais notre solution via le filtre semble très rapide en le tapant à la main?
Je souhaiterais juste automatiser cette recherche en l’intégrant dans une autre macro.
Et si possible ensuite ajouter la recherche une fois filtré si=0 pas de message et si >0 message

Techniquement l’utilisation du fitre ressemble à ceci:

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

Cela fonctionne, dans cet exemple, seules les « rondelles » sont filtrées. Seulement il y a un hic (et pas des moindres), je ne parviens pas à « annuler » la filtration …

1 « J'aime »

Je viens de tester ce code en pas à pas:

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

Le filtre s’applique bien à la fenêtre graphique (partie CAO), seul ma pièce filtré apparait dans cette zone graphique.
Par contre le feature manager reste figé. (arborescence complète de l’assemblage et rien d’apparent dans le filtre.
Bug de ma version 2023 SP05 ou comportement normal?
Ou mauvaise fonction?

@Maclane pour annuler un filtre il faut mettre «  » dans value ou searchtext=«  » pour ton code

Même comportement avec ton code:

Uniquement les rondelles apparaissent à droite.
Mais rien dans le feature manager.
Méthode macro:


Méthode manuelle:

sous Solidworks 2022 même constat, seule la vue graphique est impactée.

1 « J'aime »

@sbadenis : chez toi aussi la commande :
searchtext=« »
Est incroyablement lente ?

J’ai essayé avec:
searchtext= vbNullString
mais ce n’est pas mieux…

1 « J'aime »

As-tu regardé du coté de TreeManager des outils Mycad (il est caché dans le déroulant "outils de references):
image

Cela ne répond évidement pas à tous tes besoin mais c’est aussi une option pour la filtration multi-critéres:

Nota : J’ai vraiment du mal à comprendre la logique Visiativ qui consiste à cacher leurs outils, voir à ne plus les installer par défaut … cela ne pousse pas à la consommation…


il y a peut-être une autre piste possible en passant par Les sélections avancées.
image
(option souvent oubliée de Solidworks).

quelques exemples VBA sont disponibles dans les aides API :
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 : Je viens de me rendre compte que c’est la fonction utilisée par la macro de CodeStack citée un peu plus haut…

2 « J'aime »

@Maclane Oui pour moi aussi cela met « 2 h » à rafraichir la vue!
Pour l’utilisation de TreeManager, pas possible je veux ajouter cela dans une macro existante.
Si je passe par un utilitaire ext à SW les dessinateurs ne le feront pas systématiquement et derrière cela génère des erreurs pièces à remplacés non détectés.
Pour les utilitaires en nombre limités je crois que c’est pas du à Visiativ mais Windows ou Dassault je sais plus, qui ont créer cette limitation (Cf hotline)
Pour la sélection avancées, je viens de tester cela fonctionne pour des pièce dans l’assemblage en revanche dans un sous-assemblage il ne trouve plus la pièce.
Cela semblait pourtant parfait!

1 « J'aime »

A défaut de trouver une solution fiable via les API, j’ai développé une macro.
Elle parcours l’arborescence (avec les sous niveaux) puis exporte un rapport html.
Voici le code pour ceux qui le désire.

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

Et le module de class (A nommer clsObject):

Public Chemin As String, Designation As String ', Nom As String

Merci @Maclane pour les propositions et la confirmation du bug, qui m’a donc détourné de ma 1ère idée.

2 « J'aime »

Finalement la vérité était ailleurs.

2 « J'aime »

Merci @Sylk a 2 doigts de te mettre comme meilleurs réponse! :rofl: :rofl: :rofl:

2 « J'aime »