Comment créer un filtre de propriété pour les calques.

[DenisHen]

Bonjour à toutes et à tous.

Voilà, ça faisait longtemps que je n'étais pas venu posté sur CadXP, sans jamais oublier de le consulter quotidiennement et de proposer ma connaissance, si elle était utile...
Je suis en train de faire un fichier Excel qui créé des calques (avec plein d'options) dans AutoCAD.
Mais je ne sais pas comment faire pour créer des filtres de propriété de calques dans l'explorateur de calques AutoCAD en VBA.

Un membre de CadXP (Gile ou Patrick, je ne sais plus) m'avait donné un Lisp, mais j'aimerais le faire en VBA. Voici ce Lisp : 

;;;*********************************
;;; Création d'un filtre de calques 
;;;*********************************
(defun c:CreerFiltre (nom filtre / dict ndic xdic)
  (setq xdic (vla-getextensiondictionary
               (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))) ;_ Fin de vla-get-layers
             ) ;_ Fin de vla-getextensiondictionary
  ) ;_ Fin de setq
  (and (vl-catch-all-error-p
         (setq dict (vl-catch-all-apply 'vla-item (list xdic "ACAD_LAYERFILTERS")) ;_ Fin de vl-catch-all-apply
         ) ;_ Fin de setq
       ) ;_ Fin de vl-catch-all-error-p
       (setq dict (vla-addobject xdic "ACAD_LAYERFILTERS" "AcDbDictionary")) ;_ Fin de setq
  ) ;_ Fin de and
  (and (vl-catch-all-error-p (setq ndic (vl-catch-all-apply 'vla-item (list dict nom)))) ;_ Fin de vl-catch-all-error-p
       (setq ndic (vla-addxrecord dict nom))
  ) ;_ Fin de and
  (vlax-invoke ndic 'setxrecorddata '(1 1 1 1 70 1 1) (list nom filtre "*" "*" 0 "*" "*")) ;_ Fin de vlax-invoke
  (princ)
) ;_ Fin de defun

Si quelqu'un a une solution, un conseil ou une astuce... je suis preneur...

Bonne journée au forum...

Denis...

[(gile)]

Salut,

C'est quoi le problème avec le LISP ?
Quoi qu'il en soit, c'est du vlisp, c'est 'presque' du VBA.

1. On récupère le dictionnaire d'extension de la table des calques :

  (setq xdic (vla-getextensiondictionary
               (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))) ;_ Fin de vla-get-layers
             ) ;_ Fin de vla-getextensiondictionary
  ) ;_ Fin de setq

En VBA, ça serait quelque chose comme :

Dim xdict As AcadDictionary
Set xdict = ThisDrawing.Layers.GetExtensionDictionary()

2. On cherche le dictionnaire "ACAD_LAYERFILTERS" comme entrée du dictionnaire d'extension mais si l'entrée n'existe pas, ça génère une erreur. on peut alors ajouter cette entrée au dictionnaire d'extension (il faut voir le (and ...) comme un (if ...) :

  (and (vl-catch-all-error-p
         (setq dict (vl-catch-all-apply 'vla-item (list xdic "ACAD_LAYERFILTERS")) ;_ Fin de vl-catch-all-apply
         ) ;_ Fin de setq
       ) ;_ Fin de vl-catch-all-error-p
       (setq dict (vla-addobject xdic "ACAD_LAYERFILTERS" "AcDbDictionary")) ;_ Fin de setq
  ) ;_ Fin de and

en VBA, je ne suis pas très sûr de moi avec la célèbrement calamiteuse gestion des erreurs du VBA, mais ça devrait être quelque chose comme ça:

Dim dict As AcadDictionary
On Error GoTo ErrorHandler
Set dict = xdict.Item("ACAD_LAYERFILTERS")
ErrorHandler:
Set dict = xdic.AddObject("ACAD_LAYERFILTERS", "AcDbDictionary")
Resume Next

 

3. On refait la même chose pour le Xrecord, entrée du dictionnaire "ACAD_LAYERFILTERS" :

Dim ndict As AcadXRecord
On Error GoTo ErrorHandler
Set ndict = dict.Item(nom)
ErrorHandler:
Set ndict = dic.AddXRecord(nom)
Resume Next

 

4. On définit les données du Xrecord :

(vlax-invoke ndic 'setxrecorddata '(1 1 1 1 70 1 1) (list nom filtre "*" "*" 0 "*" "*"))

Ce qui devrait pouvoir s'écrire en VBA :

Dim dataType As Variant
Dim dataValue As Variant
Set dataType = Array(1 1 1 1 70 1 1)
Set dataValue = Array(nom filtre "*" "*" 0 "*" "*")
ndic.SetXRecordData(dataType, dataValue)

 

[DenisHen]

Bonjour (gile).
J'avoue ne pas avoir tout compris, bien que ce soit tout de même bien expliqué.
Le Lisp ne me cause aucun problème (quand je l'utilise en Lisp), il fonctionne très très bien... (sauf un petit problème de mis à jour dans l'explorateur de calques, mais je sais que c'est AutoCAD qui est le problème, car il suffit de changer de dessin et de revenir au précédent pour que les filtres créés par ce Lisp apparaissent).
Je cherchais juste à faire de ce super Lisp un VBA.
Je vais creuser tes différentes solutions et exemples pour intégrer tout ça dans mon VBA...
Mais j'ai du boulot, cela fait 20 ans que je n'ai pas touché au VBA...

Encore merci à toi (gile).

Denis...

[(gile)]

Concernant les dictionnaires et xrecords, tu peux voir ce sujet. Les exemple de code sont en LISP mais la 'théorie' sur les dictionnaires et xrecords vaut quel que soit l'environnement de développement.

[DenisHen]

Ok, merci (gile), je vais regardé ça, mais je l'avais déjà lu, et comme l'a dit quelqu'un, je suis aussi un primate... 😉 

[Curlygoth]

salut,

Pour gagner du temps dans le code... car je gère pas super bien les dictionnaires...

j'ai créé un programme qui gère les calques suivant un nom de filtres que tu peux donner à une liste de calques.

(Pourrais pas te donner de code mais tu peux t'en inspirer ^^)

l'idée c'est de donner un nom à une liste de calques que tu vas pouvoir afficher ou masqué

(derrière c'est juste une lecture du fichier qui stocke les infos ou écrit les infos de la liste)

Plutôt que de générer des calques depuis excel fait les directement dans autocad et à la limite stock les "règles" de tes gabarits dans un fichier

[(gile)]

@Curlygoth

Le titre du sujet est : "Comment créer un filtre de propriété pour les calques.", ce que tu proposes ressemble à ce qui existe nativement dans AutoCAD et s'appelle : filtre de groupe.

[Curlygoth]

A oups... ^^'

même principe ? sauf qu'au lieu d'avoir des calques ont a les propriétés ?

Name (string)

Freeze (boolean)

layerOn (boolean)

Plotable (boolean)

...

et pour le système je ferais pareil même si effectivement on peut le faire nativement...

[didier]

Bonjour @DenisHen

Il y a quelque temps que je ne suis pas venu répondre à un de tes messages, je respire encore et toi tu questionnes encore (hihi)...
J'en dirai plus sur mon site, car il semble que le VBA rassemble toujours des adeptes, mais dans un premier temps je vais te donner un code que tu pourras copier-coller. L'action de mon exemple est de filtrer les calques dont le nom commence par "cal", calque1, calque2, calquex...
Libre à toi de l'étudier ou de l'utiliser tel quel, car il est fonctionnel, mais j'expliquerai plus avant les détails sur "da-code".

Allez, je colle le code, car si je me laisse aller je vais dégoiser, je ne suis pas d'humeur...

Option Explicit

Sub daMakeLayerFilter()
Dim DaRec As AcadXRecord
Dim Dict1 As AcadDictionary, Dict2 As AcadDictionary
Dim DaType(0 To 6) As Integer
Dim DaValue(0 To 6) As Variant
Dim name As String

name = "FiltreCalque" 
DaType(0) = 1: DaValue(0) = name 
DaType(1) = 1: DaValue(1) = "cal*" 
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(name)
DaRec.SetXRecordData DaType, DaValue
ThisDrawing.Utility.Prompt "Un filtre de calques (propriétés) nommé : <" & name & " ajouté dans la liste" & vbCrLf
End Sub

 

[DenisHen]

Bonjour @didier.

Mille mercis ! ! ! C'est exactement ça ! ! !

J'ai encore un petit problème pour créer un calque avec un type de ligne et une épaisseur, mais je sais que j'ai déjà écris quelque-chose là-dessus...

Encore merci...

Denis...