Soucis avec une création de "sous-filtre" de calques.

[DenisHen]

Bonjour à la communauté.

Il y a quelques temps, ce forum m'avait sauvé la vie avec ce code, pour créer un filtre de calques.

Public Sub CreaFiltre(NomFiltre As String)
    'Création de filtres **********************************************
    Dim Dict1 As Object
    Dim Dict2 As Object
    Dim DaRec As Object
    Dim DaType(0 To 6) As Integer
    Dim DaValue(0 To 6) As Variant
    If NomFiltre <> "" Then
        DaType(0) = 1: DaValue(0) = NomFiltre
        DaType(1) = 1: DaValue(1) = NomFiltre & "*"
        DaType(2) = 1: DaValue(2) = "*"
        DaType(3) = 1: DaValue(3) = "*"
        DaType(4) = 70: DaValue(4) = 0
        DaType(5) = 1: DaValue(5) = "*"
        DaType(6) = 1: DaValue(6) = "*"

        Set Dict1 = ThisDrawing.Layers.GetExtensionDictionary
        Set Dict2 = Dict1.AddObject("ACAD_LAYERFILTERS", "AcDbDictionary")
        Set DaRec = Dict2.AddXRecord(NomFiltre)
        DaRec.SetXRecordData DaType, DaValue
    End If
End Sub

Et il fonctionne à merveille ! ! !

Mais maintenant, je me retrouve avec trop de filtres, j'aimerais donc créer des "sous-filtres". Et des "sous-sous-filtres"

Comme :
Denis1
   -Denis2
         -Denis3

Avec un Sub comme ceci, je pense :

Public Sub CreaFiltre(NomFiltre As String, NomFiltreParent As String)
	...
	...
End Sub

Par exemple, le filtre "Denis2" serait un "sous-filtre" de "Denis1", un peu comme l'arborescence des répertoires...

J'ai cherché "ACAD_LAYERFILTERS", mais là Google n'était pas mon ami...

Si quelqu'un a une astuce, un conseil... Je suis preneur...

Bien à toi la communauté...

Denis...

[Luna]

Coucou,

Je ne sais pas si cela pourra t'aider mais j'avais ouvert ce sujet il y a un moment :

Bisous,
Luna

[GEGEMATIC]

Salut Denis,

je ne retrouve pas mes petits ce matin,

j'ai des truc plus clairs j'en suis sur, mais voilà un bout de code qui permet de créer un filtre et un sous filtre exemple:

filtre "essai3" et sous filtre "sous-filtre-essai3"

Une chose très importante à savoir: chaque nom de filtre ou sous filtre doit être unique.

J'avais créé un générateur de filtre de calque pour Covadis basé sur un tableau excel, et des sous filtre génériques, j'ai cru devenir dingue avant de comprendre.

Par exemple, si tu fait deux filtres "plateforme_brut" "plateforme_fini"

tu te dis, je vais pouvoir leur coller les sous-filtres génériques "hachures" "texte" etc...

et bien non !

il faut incrémenter le nom de tes sous filtres pour qu'il soient unique (ou concaténer avec le nom du filtre etc ...)

 "plateforme_brut"

      "hachures"

       "texte"

"plateforme_fini"

      "hachures1"

       "texte1"

 

;;;1er proto
(defun c:layerfiltercreator	(/ doc profile dict lfent cur datalist xname)
  (vl-load-com)
  (setq	doc	(vla-get-activedocument (vlax-get-acad-object))
	profile	(vla-get-ActiveProfile (vla-get-Profiles (vla-get-preferences (vlax-get-acad-object))))
	dict	(vlax-vla-object->ename (vla-GetExtensionDictionary (vla-get-layers doc)))
	lfent	(cdar (print (dictsearch dict "ACLYDICTIONARY")))
  )
  ;(print "************")
  ; check to see if "ACAD_LAYERFILTERS" exists. if not, make it
  (if (not lfent)
    (progn (setq cur '((0 . "DICTIONARY") (100 . "AcDbDictionary")))
	   (setq lfent (dictadd dict "ACLYDICTIONARY" (entmakex cur)))
    )
  )
  (if (setq lsousdic (pw_vlax_list_items (vlax-ename->vla-object lfent)))
    (setq name (pw_inc_ch  (last (pw_num_strlsort (mapcar 'vla-get-name lsousdic))) 1))
    (setq name "*A1")
  )

  (setq xdlist
	 (list '(0 . "XRECORD")'(100 . "AcDbXrecord") '(280 . 1) '(1 . "AcLyLayerFilter") 
				'(90 . 1) (cons 300  "essai3") '(301 . "NAME==\"*filtre-essai3\""))
 	xname	 (entmakex xdlist)
  )
  ;;création des niveaux 2 et 3
  (if (setq monfiltre (dictadd lfent name xname))
    (progn
     (print monfiltre)
     ;;création des niveaux 4, 5 et 6
     ;; niveau 4

     ;(setq cur '((0 . "DICTIONARY") (100 . "AcDbDictionary")))
;	   (setq exdic (dictadd monfiltre "ACLYDICTIONARY" (entmakex cur)))
     (setq objxdic (vla-GetExtensionDictionary (vlax-ename->vla-object monfiltre)))
     ;(vlax-dump-object objxdic)
     (setq exdic (vlax-vla-object->ename objxdic))
     
     ;; niveau 5
     (setq xdlist
	 (list '(0 . "DICTIONARY") '(100 . "AcDbDictionary") '(280 . 0) '(281 . 1))
	   xname	 (entmakex xdlist))
     (setq dictniv5 (dictadd exdic "ACLYDICTIONARY"  xname))
     (entget dictniv5)

     ;; niveau 6

      (setq xdlist
	 (list '(0 . "XRECORD")'(100 . "AcDbXrecord") '(280 . 1) '(1 . "AcLyLayerFilter") 
				'(90 . 1) (cons 300  "sous-filtre-essai3") '(301 . "NAME==\"*sous-filtre-essai3\""))
 	xname	 (entmakex xdlist)
	    
    )
         (setq dictniv6 (dictadd dictniv5 "*A1"  xname))
     (entget dictniv6)

     

       ;;
     )
    )

  (princ)
)

 

[DenisHen]

Bonjour à tous, et merci pour votre aide.
J'ai essayé de mettre tout ça en VBA, mais je n'ai pas réussi...
Étant très mauvais en "Dictionnaire", je ne m'étonne pas...
Encore merci à vous...
Denis...

[GEGEMATIC]

Salut Denis,

 désolé, je n'avais pas vu qu'il y a avait des fonction PW_ dans ce que je t'ai donné.

pw_vlax_list_items liste les éléments d'une collection, peut être avntageuesement remplacé en utilisant 
vlax-for
par exemple lister les calques:
(vlax-for lay (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))) (setq llay (cons lay llay)))

Ensuite il me semble qu'on ne peut pas tout faire en activex avec les dictionnaires, de mémoire j'utilise une DLL de Gile pour contourner ce problème, que l'on a qu'en activex

sauf qu'en activex, on arrive mieux à gérer ses séquences qu'en "dxf" (je veux dire entget, entmod, entmake et enmakex ...)

Du coup c'est un immonde gloubi-boulga ...

Voilà les schéma de ces sous filtre, par moi et par Gile:

;;;Récapitulation simplifiée:
;;;1 DICTIONARY
;;;	2 DICTIONARY
;;;		3 XRECORD du 1er filtre
;;;			4 DICTIONARY (ACAD_XDICTIONARY: ne peux pas etre créé par dictadd, mais par la méthode getextensiondictionary)
;;;				5 DICTIONARY
;;;					6 XRECORD du sous filtre

le 4 est en fait un dictionnaire d'extension, ce qu'explique mieux Gile:

Table des calques
    |_Dictionnaire d'extension
        |_Dictionnaire "ACAD_LAYERFILTERS"
        |_Dictionnaire "ACAD_LAYERSTATES"
        |_Dictionnaire "ACLYDICTIONARY"
            |_Xrecord "*A1"
            |_Xrecord "*A2"
                |_Dictionnaire d'extension
		            |_Dictionnaire "ACLYDICTIONARY"
	                    |_Xrecord "*A1"

Bon courage !

a+

Gégé

[DenisHen]

Salut Gégé, et merci pour ton aide.

Je vais donc aller voir le site de Gile pour télécharger cette DLL, je pense y trouver sa dernière version.

Encore un grand merci à la communauté.

Denis...

[(gile)]

J'ai un peu regardé (ça faisait longtemps que je n'avais pas joué avec les filtres de calque).

Pour pouvoir créer des sous filtres, il faut partir d'un Xrecord dans le dictionnaire "ACLYDICTIONARY" du filtre parent.
Il faut donc créer cette entrée quand on crée le filtre à la "racine" de notre arbre et le faire dans une Function pour renvoyer ce Xrecord.

On peut ensuite créer une autre Function pour créer un sous filtre qui renverra le sous filtre nouvellement créé pour pouvoir éventuellement lui ajouter un sous filtre, etc.

Un exemple (pas testé) avec une méthode de test qui crée un premier filtre pour tous les calques dont le nom commence par un chiffre (sauf 0), puis un sous filtre de celui-ci pour les claques remplissant la première propriété et qui ne sont pas gelés et enfin un sous filtre de ce dernier pour les claques de couleur rouge.

Public Function CreaFiltrePrefixe(NomFiltre As String, Modele As String) As Object
	Dim XDict As Object
	Dim Dict1 As Object
	Dim Dict2 As Object
	Dim Xrec1 As Object
	Dim Data1Type(0 To 6) As Integer
	Dim Data1Value(0 To 6) As Variant
	Dim XdataType(0 To 1) As Integer
	Dim XdataValue(0 To 1) As Variant
	Dim Data2Type(0 To 4) As Integer
	Dim Data2Value(0 To 4) As Variant

	' création du filtre dans "ACAD_LAYERFILTERS"
	Set XDict = ThisDrawing.Layers.GetExtensionDictionary
	Set Dict1 = XDict.AddObject("ACAD_LAYERFILTERS", "AcDbDictionary")
	Set Xrec1 = Dict1.AddXRecord(NomFiltre)

	Data1Type(0) = 1: Data1Value(0) = NomFiltre
	Data1Type(1) = 1: Data1Value(1) = Modele
	Data1Type(2) = 1: Data1Value(2) = "*"
	Data1Type(3) = 1: Data1Value(3) = "*"
	Data1Type(4) = 70: Data1Value(4) = 0
	Data1Type(5) = 1: Data1Value(5) = "*"
	Data1Type(6) = 1: Data1Value(6) = "*"
	Xrec1.SetXRecordData Data1Type, Data1Value

	XdataType(0) = 1001: XdataValue = "ACAD"
	XdataType(1) = 1000: XdataValue = NomFiltre
	Xrec1.SetXdata XdataType, XdataValue

	' création du filtre dans "ACLYDICTIONARY"
	Set Dict2 = XDict.AddObject("ACLYDICTIONARY", "AcDbDictionary")
	Set Xrec2 = Dict2.AddXRecord("*") 

	Data2Type(0) = 290: Data2Value(0) = 1
	Data2Type(1) = 1: Data2Value(1) = "AcLyLayerFilter"
	Data2Type(2) = 90: Data2Value(2) = 1
	Data2Type(3) = 300: Data2Value(3) = NomFiltre
	Data2Type(4) = 301: Data2Value(3) = "NAME==""" & Modele & """"
	Xrec2.SetXRecordData(Data2Type, Data2Value)
	
	' valeur renvoyée
	CreaFiltrePrefixe = Xrec2

End Function

Public Function CreaSousFiltre(Filtre As Object, NomFiltre As String, Regle As String) As Object
	Dim XDict As Object
	Dim Dict As Object
	Dim Xrec As Object
	Dim DataType(0 To 4) As Integer
	Dim DataValue(0 To 4) As Variant

	Set XDict = Filtre.GetExtensionDictionary
	Set Dict = XDict.AddObject("ACLYDICTIONARY", "AcDbDictionary")
	Set Xrec = Dict.AddXRecord("*") 

	DataType(0) = 290: DataValue(0) = 1
	DataType(1) = 1: DataValue(1) = "AcLyLayerFilter"
	DataType(2) = 90: DataValue(2) = 1
	DataType(3) = 300: DataValue(3) = NomFiltre
	DataType(4) = 301: DataValue(3) = Regle
	Xrec.SetXRecordData DataType, DataValue

	' valeur renvoyée
	CreaSousFiltre = Xrec
	
End Function

' Test crée un filtre pour les calques dont le nom commence par un chiffre sauf 0,
' qui contient un sous filtre pour les calques non-gelés
' qui contient un sous filtre pour les calques de couleur rouge
Public Sub Test()
	Dim Filtre As Object
	Dim SousFiltre1 As Object
	Dim SousFiltre2 As Object

	Set Filtre = CreaFiltrePrefixe("Filtre1", "[1-9]*")
	Set SousFiltre1 = CreaSousFiltre(Filtre, "Filtre2", "FROZEN==""False""")
	Set SousFiltre2 = CreaSousFiltre(SousFiltre1, "Filtre3", "COLOR==""1""")

 

[DenisHen]

Bonjour (gile) et mille mercis pour ton aide.
Je regarderais ça plus tard, on est plus que débordé en ce moment...
Peux-tu me confirmer ce que disait Gégé plus haut : "Une chose très importante à savoir : chaque nom de filtre ou sous filtre doit être unique." ?
Pour les filtres, je conçois, mais pour les sous-filtres ? Exemple :
|-Rdc
      |--Murs
      |--Cloisons
|-1er
      |--Murs
      |--Cloisons
|-2ème
      |--Murs
      |--Cloisons

Encore un super grand merci à tous...
Denis...

[Luna]

Coucou,

Vui je te confirme ! Même si je reconnais que c'est stupide, je suppose qu'AutoCAD ne comprend pas correctement le principe de filtres et sous-filtres et donc même si deux sous-filtres appartiennent à deux filtres différents, il n'auront pas le préfixe correspondant au filtre parent, obligeant ainsi d'avoir deux nom différents pour les sous-filtres.

Donc comme suggéré, le plus simple est d'ajouter un numéro pour éviter les doublons sans faire trop lourd

Bisous,
Luna

[DenisHen]

Salut Luna, et merci de me m'aider.
Ben cha alors ! ! !
Je vais donc "développer" en conséquence. Mais je suis d'accord, c'est stupide...
Après, c'est peut-être un méli-mélo entres dictionnaires...
Encore merci...
Denis...

[DenisHen]

Bonjour à tous.
Je me suis remis sur mon problème. J'ai bien compris l'arborescence à adopter, que j'ai d'ailleurs fais évoluer :
 

|-Rdc
      |-Rdc-Coupes
          |-Rdc-Coupes-Murs
          |-Rdc-Coupes-Cloisons
      |-Rdc-Plans
          |-Rdc-Plans-Murs
          |-Rdc-Plans-Cloisons
|-1er
      |-1er-Coupes
          |-1er-Coupes-Murs
          |-1er-Coupes-Cloisons
      |-1er-Plans
          |-1er-Plans-Murs
          |-1er-Plans-Cloisons

Mais je n'arrive pas à créer le premier sous filtre.
Je ne comprends pas très bien les dictionnaires, même après la lecture de plusieurs documentations (PDF, sites...)

[(gile)]

As-tu essayé le code que j'ai donné plus haut ?

[DenisHen]

Bonjour (gile), oui, je l'ai essayé. 
Mais j'ai du mal avec les Function, je n'utilise que des Sub. J'ai surement tord, mais j'ai appris comme-ça, désolé...
C'est peut-être pour ça que je n'y arrive pas, j'ai essayé de transformer ton code en ma façon de travailler.
En gros, j'essaye de faire deux Sub : 
- création du filtre "principal",
- création d'un sous-filtre, qui peux être un sous-sous-filtre...
Je ne m'en sors pas vraiment, pourtant, ça fait deux semaines que je manges des "dictionnaire" AutoCAD en PDF, sur des sites...
Je suis peut-être au bout de mes facultés intellectuelles... 😉 
En tous cas, merci pour ton aide...

[(gile)]

il y a 35 minutes, DenisHen a dit :

Mais j'ai du mal avec les Function, je n'utilise que des Sub. J'ai surement tord, mais j'ai appris comme-ça, désolé...

Tu as raison de dire que tu as tord, et ce n'est pas parce que tu as appris des mauvaises manières qu'il ne faut pas en changer...

La différence entre une procédure Sub et une procédure Function est simplement que la première exécute une action sans renvoyer de valeur et que la seconde renvoie toujours une valeur. 
MsgBox, par exemple est une procédure Function qui renvoie nombre entier correspondant au bouton cliqué pour fermer la boite.

Dans le cas qui nous occupe, pour créer un sous-filtre de calque, il faut connaitre le filtre de calque "parent".
Avec une procédure Sub, on peut très bien créer un filtre de calque, mais le filtre créé n'est connu que de cette procédure (puisqu'elle ne renvoie rien) à moins d'utiliser un "effet de bord", en utilisant une variable globale, par exemple. Par contre, utiliser une procédure Function pour créer un filtre de calque permet de renvoyer le filtre nouvellement créé par la procédure. Ceci permet de simplifier le code qui utilise cette fonction et surtout de le rendre plus robuste (plus facile à déboguer et à maintenir).

Dans l'exemple que j'ai donné, les procédures "CreaFiltrePrefixe" et "CreaSousFiltre" renvoient le filtre de calque créé. Ceci qui permet à la fois de créer un filtre et de récupérer directement ce filtre dans une variable pour pouvoir éventuellement le passer en argument à un nouvel appel de "CreaSousFiltre" pour créer un filtre "enfant" du filtre nouvellement créé.

	Set Filtre = CreaFiltrePrefixe("Filtre1", "[1-9]*")
	Set SousFiltre1 = CreaSousFiltre(Filtre, "Filtre2", "FROZEN==""False""")
	Set SousFiltre2 = CreaSousFiltre(SousFiltre1, "Filtre3", "COLOR==""1""")

 

Alors s'il te plait, essaye le code que j'ai posté plus haut et s'il crée bien un premier filtre pour tous les calques dont le nom commence par un chiffre (sauf 0), puis un sous filtre de celui-ci pour les claques qui ne sont pas gelés et enfin un sous filtre de ce dernier pour les claques de couleur rouge, tu n'as qu'à modifier la procédure SUB "Test" pour l'adapter à tes besoins :

Public Sub Test()
	Dim Rdc As Object
	Dim RdcCoupes As Object
	Dim RdcCoupesCloisons As Object
	Dim RdcCoupesMurs As Object

	' création du filtre de calque "Rdc" et stockage du filtre dans la variable "Rdc"
	Set Rdc = CreaFiltrePrefixe("Rdc", "Rdc*")
	
	' création du sous-filtre de calque "RdcCoupes" et stockage du filtre dans la variable "RdcCoupes"
	Set RdcCoupes = CreaSousFiltre(Rdc, "Rdc-Coupes", "NAME==""Rdc-Coupes*""")
	
	' création du sous-filtre de calque "RdcCoupesCloisons" et stockage du filtre dans la variable "RdcCoupesCloisons"
	' au cas où on voudrait créer des sous-filtres de celui-ci
	Set RdcCoupesCloisons = CreaSousFiltre(RdcCoupes, "Rdc-Coupes-Cloisons", "NAME==""Rdc-Coupes-Cloisons*""")
	
	' création du sous-filtre de calque "RdcCoupesMurs" et stockage du filtre dans la variable "RdcCoupesMurs"
	' au cas où on voudrait créer des sous-filtres de celui-ci
	Set RdcCoupesMurs = CreaSousFiltre(RdcCoupes, "Rdc-Coupes-Murs", "NAME==""Rdc-Coupes-Murs*""")

 

[DenisHen]

Un grand merci à toi (gile), je prends toujours tes remarques et commentaires très au sérieux, raison pour laquelle je me coltine des pages et des pages d'explications plus compliquées les unes que les autres sur les dictionnaires depuis deux semaines...
Étant habitué aux Sub, je ne comprends pas réellement l'intérêt d'un Function pour avoir une réponse en retour, alors que j'envois un "ordre" avec un Sub et pas une "question" comme avec un Function, La seule réponse à laquelle je m'attendrai, éventuellement, c'est "OK" ou "PasOk".
Je ne comprends pas encore l'intérêt de lancer une procédure qui devrait marcher seule pour en attendre une réponse, pour en faire quoi ? 
Je comprendrais pour un calcul et en avoir le résultat. Un Function qui ajouterais la TVA ou enlèverais un pourcentage d'enrobage par exemple...
Je compare ma pensée avec une commande AutoCAD (si tu le permets), je créé un calque en ligne de commande avec "-calques"... Ai-je besoin d'une réponse ?
Par contre, je l'ai bien remarqué en Lisp, les appels de procédure avec arguments, c'est génial, mais en VBA, il y a une grande différence, je trouve. Mais comme je l'ai déjà dis, peut-être suis-je à mon maximum... Suis-je con, ou tout simplement bête ? ? ?
En Lisp, tu lances un defun avec parfois des arguments (je ne le fais presque jamais, j'utilise toujours des vlax-ldata pour dialoguer entre mes différentes commandes), mais je pense que ce doit être la même chose en VBA.

Tu dis qu'un Function est plus facile à gérer qu'un Sub. Je vais le découvrir, car je vais chercher...

Encore un grand merci à toi...

Denis...

[(gile)]

Je vais essayer une dernière fois de me faire comprendre.

Tu utilises déjà très certainement des procédures Function natives, comme par exemple la méthode Add qui permet d'ajouter un élément une collection.
On peu très bien utilise une procédure Function comme si c'était une procédure Sub en ignorant la valeur de retour.

Par exemple pour créer un nouveau calque et lui affecter la couleur rouge (ACI 1) en ignorant la valeur renvoyée par la méthode Add (un objet AcadLayer dans ce cas).

' on déclare une variable
Dim calque As AcadLayer

' on crée un nouveau calque
ThisDrawing.Layers.Add("TOTO")

' on retrouve ce calque pour l'affecter à la variable
newLayer = ThisDrawing.Layers.Item("TOTO")

' on affecte une couleur au calque
newLayer.Color = 1

Mais il est plus simple d'utiliser directement la valeur renvoyée par Add (et c'est probablement ce que tu fais).

' on déclare une variable
Dim calque As AcadLayer

' on crée un nouveau calque et on l'affecte à la variable
Set calque = ThisDrawing.Layers.Add("TOTO")

' on affecte une couleur au calque
newLayer.Color = 1

 

C'est exactement la même chose avec les procédure que tu crées.

Pour créer un premier filtre de calque, on a besoin d'une utiliser une procédure.
Pour créer un sous-filtre de calque, enfant du premier, il faut un procédure un peu différente de la première qui a besoin de "connaitre" le filtre de calque parent.

En utilisant une procédure Sub, je peux très bien créer mon premier filtre calque, mais pour créer un sous-filtre il va falloir que je retrouve ce filtre d'une manière ou d'une autre.

Si j'utilise une procédure Function en tout point similaire à la procédure Sub si ce n'est qu'en plus elle renvoie le filtre créé, et je vais pouvoir utiliser directement cette valeur de retour pour créer le sous-filtre, sans avoir besoin de parcourir tous les filtres ou d'utiliser un stockage externe à la procédure pour la retrouver.

Il en va de même pour la création des sous-filtres.

[DenisHen]

Ok, merci (gile), je commence à comprendre l'utilité ou du moins, la différence entre un Function et un Sub.  Bien que...
Tu as raison, je fonctionne comme tu le suppose dans ta proposition, je n'envoi que des ordres (Sub) et je n'ai jamais besoin de réponses (Function).
Je vais avaliser ta réponse pour en sortir sa substantifique moelle.
Encore un grand merci à toi pour tout ton aide gracieuse et précieuse...
Mais j'ai des heures de réflexion... Je vais dollipraner mes exercices à venir...
Encore merci pour ton aide, tellement précieuse, même pour une dernière fois...
Denis...

[Curlygoth]

(c'est pourquoi je te répète depuis plus d'un an maintenant d'utilisé les fonction et je viens de comprendre pourquoi tu ne le faisais pas...)

Citation

pense que ce doit être la même chose en VBA.

OUI !! et tu peux aussi mettre en argument tout et n'importe quoi ! une variable, une liste, un tableau, un objet !

de cette manière relis mes réponse a tes question et je pense que tu comprendras mes fonctions sur toutes mes réponses

et dans les modules/userform tu peux mettre en entête une variable, table, objet pour réserver le nom et le conserver dans tes procédures / fonctions qui du coup pourront conserver une variable commune (je l'utilise toujours pour mes userforms)