Aller au contenu

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


DenisHen
 Partager

Messages recommandés

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...

Windows 10 Pro 64bits / AutoCAD MAP 3D 2019

Sur terre, il y a 10 types de personnes, celles qui comptent en binaire et les autres...
Davantage d'avantages, avantagent davantage. (Bobby Lapointe)
La connaissance s'accroît quand on la partage.(Socrate)

Lien vers le commentaire
Partager sur d’autres sites

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)

 

Gilles Chanteau - gileCAD -
Développements sur mesure pour AutoCAD
ADSK_Expert_Elite_Icon_S_Color_Blk_125.png

Lien vers le commentaire
Partager sur d’autres sites

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...

Windows 10 Pro 64bits / AutoCAD MAP 3D 2019

Sur terre, il y a 10 types de personnes, celles qui comptent en binaire et les autres...
Davantage d'avantages, avantagent davantage. (Bobby Lapointe)
La connaissance s'accroît quand on la partage.(Socrate)

Lien vers le commentaire
Partager sur d’autres sites

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... 😉 

Windows 10 Pro 64bits / AutoCAD MAP 3D 2019

Sur terre, il y a 10 types de personnes, celles qui comptent en binaire et les autres...
Davantage d'avantages, avantagent davantage. (Bobby Lapointe)
La connaissance s'accroît quand on la partage.(Socrate)

Lien vers le commentaire
Partager sur d’autres sites

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

image.thumb.png.1b1b6a232bd966083d4b94ef2c8b3695.png

Lien vers le commentaire
Partager sur d’autres sites

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...

Lien vers le commentaire
Partager sur d’autres sites

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

 

Lien vers le commentaire
Partager sur d’autres sites

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...

Windows 10 Pro 64bits / AutoCAD MAP 3D 2019

Sur terre, il y a 10 types de personnes, celles qui comptent en binaire et les autres...
Davantage d'avantages, avantagent davantage. (Bobby Lapointe)
La connaissance s'accroît quand on la partage.(Socrate)

Lien vers le commentaire
Partager sur d’autres sites

Rejoindre la conversation

Vous pouvez publier maintenant et vous inscrire plus tard. Si vous avez un compte, connectez-vous maintenant pour publier avec votre compte.

Invité
Répondre à ce sujet…

×   Collé en tant que texte enrichi.   Coller en tant que texte brut à la place

  Seulement 75 émoticônes maximum sont autorisées.

×   Votre lien a été automatiquement intégré.   Afficher plutôt comme un lien

×   Votre contenu précédent a été rétabli.   Vider l’éditeur

×   Vous ne pouvez pas directement coller des images. Envoyez-les depuis votre ordinateur ou insérez-les depuis une URL.

Chargement
 Partager

×
×
  • Créer...