Interception événement création d’un calque

[ASTERIXII]

Bonjour,

 

Je voudrais savoir si il est possible en lisp d’intercepter une action de création de calque.

 

Par exemple, un programme tiers va créer un nouveau calque, et juste âpres je voudrais « prendre la main » pour intervenir sur le dernier calque qui à été créé, et ensuite le laisser continuer. Sachant que je ne pas modifier le programme tiers.

[(gile)]

Salut,

 

Tu peux utiliser un réacteur de type vlr-acdb-reactor sur l'évènement :vlr-objectAppended pour être notifié quand un objet est ajouté à la base de données et évaluer le type d'objet.

 

(setq *LayerAddedReactor* (vlr-acdb-reactor () '((:vlr-objectAppended . layerAddedCallback))))

(defun layerAddedCallback (rea obj / elst)
 (setq elst (entget (cadr obj)))
 (if (= (cdr (assoc 0 elst)) "LAYER")
   (alert
     (strcat "le calque '" (cdr (assoc 2 elst)) "' a été ajouté")
   )
 )
)

 

Par contre, tu ne peux pas intervenir sur l'objet dans la fonction layerAddedCallback car l'objet est encore ouvert au moment où l'évènement est déclenché.

 

Pour palier à ça, une pratique courante est de définir deux nouveaux réacteurs temporaires dans le callback qui seront déclenchés quand la commande ou le LISP en cours sera terminée. Donc, je ne sais pas si ça peut répondre à ta demande.

 

Un exemple qui met tout nouveau calque créé en couleur 30.

Tu verras, si tu utilises la commande -CALQUE en ligne de commande pour créer un nouveau calque que le premier réacteur se déclenche dès que le nom du calque est entré alors que la commande n'est pas terminée. Le second réacteur, lui, se déclenche quand la commande est terminée.

 

(setq *LayerAddedReactor* (vlr-acdb-reactor () '((:vlr-objectAppended . layerAddedallback))))

(defun layerAddedallback (rea obj / elst)
 (setq elst (entget (cadr obj)))
 (if (= (cdr (assoc 0 elst)) "LAYER")
   (progn
     (alert
       (strcat "le calque '" (cdr (assoc 2 elst)) "' a été ajouté")
     )
     (setq *TmpCmdRea* (vlr-command-reactor elst '((:vlr-commandEnded . tmpCallback))))
     (setq *TmpLspRea* (vlr-lisp-reactor elst '((:vlr-lispEnded . tmpCallback))))
   )
 )
)

(defun tmpCallback (rea lst / elst)
 (setq elst (vlr-data rea))
 (entmod
   (if	(assoc 62 elst)
     (subst '(62 . 30) (assoc 62 elst) elst)
     (append elst '((62 . 30)))
   )
 )
 (vlr-remove *TmpCmdRea*)
 (vlr-remove *TmpLspRea*)
 (setq	*TmpCmdRea* nil
*TmpLspRea* nil
 )
 (alert
   (strcat
     (if (car lst)
(strcat "La commande '" (car lst) "' qui a ajouté le calque est terminée.")
"Le LISP qui a ajouté le calque est terminé."
     )
     "\nSa couleur a été modifiéé."
   )
 )
)

[ASTERIXII]

Bonjour Gil

 

Merci pour ta réponse un Dimanche !!

 

Bon ton code fonctionne, mais j'ai 2 problèmes

Le premier : à la création d'un calque, j'ai bien l'affichage des 2 boites d'alerte, mais pas le changement de couleur du calque. Pour qu'il change la couleur, je dois le charger dans l'Editeur lisp, et charger le lisp.

 

Mais ensuite, si il change la couleur en 30, il y a un message sur la ligne Autocad: Invalid Autocad command: nil

Ensuite, si je fais un nouveau calque, la case d'alerte comme quoi le calque à été ajouté s'affiche 2 fois, et de nouveau le message d'erreur. De plus le message d'erreur va s'affiché sur la ligne (à la suite) autant de fois qu'il y à eu de nouveau calque

 

Une idée ?

[(gile)]

Les réacteurs sont des choses délicates à manipuler. En période de teste il est prudent de souvent supprimer tous les ré

 

Si les boites d'alerte s'affiche 2 fois, c'est que le réacteur a été enregistré une deuxième fois quand tu as rechargé le LISP.

 

Pour éviter ça, je te propose un autre code qui définit deux commandes :

- LayerAddedReaOn pour activer le réacteur

- LayerAddedReaOff pour désactiver le réacteur

 

(defun c:LayerAddedReaOn ()
 (or
   *LayerAddedReactor*
   (setq *LayerAddedReactor* (vlr-acdb-reactor () '((:vlr-objectAppended . layerAddedCallback))))
 )
)

(defun c:LayerAddedReaOff ()
 (and
   *LayerAddedReactor*
   (vlr-remove *LayerAddedReactor*)
   (setq *LayerAddedReactor* nil)
 )
)

(defun layerAddedCallback (rea obj / elst)
 (setq elst (entget (cadr obj)))
 (if (= (cdr (assoc 0 elst)) "LAYER")
   (progn
     (alert
(strcat "le calque '" (cdr (assoc 2 elst)) "' a été ajouté")
     )
     (setq *TmpCmdRea* (vlr-command-reactor elst '((:vlr-commandEnded . tmpCallback))))
     (setq *TmpLspRea* (vlr-lisp-reactor elst '((:vlr-lispEnded . tmpCallback))))
   )
 )
)

(defun tmpCallback (rea lst / elst)
 (setq elst (vlr-data rea))
 (entmod
   (if	(assoc 62 elst)
     (subst '(62 . 30) (assoc 62 elst) elst)
     (append elst '((62 . 30)))
   )
 )
 (vlr-remove *TmpCmdRea*)
 (vlr-remove *TmpLspRea*)
 (setq	*TmpCmdRea* nil
*TmpLspRea* nil
 )
 (alert
   (strcat
     (if (car lst)
(strcat	"La commande '"
	(vl-princ-to-string (car lst))
	"' qui a ajouté le calque est terminée."
)
"Le LISP qui a ajouté le calque est terminé."
     )
     "\nSa couleur a été modifiéé."
   )
 )
)

 

Essaye dans un dessin vierge en chargeant le code depuis l'éditeur, et si tu n'as toujours pas de changement de couleur du calque nouvellement créé, décris mieux le contexte : comment a été créé le calque, quel est le message d'erreur.

 

Tu peux aussi mettre un point d'arrêt dans le code au début de la fonction tmpCallback et faire un "pas à pas" avec F8 pour localiser le problème.

Ou bien, cocher "Arrêt sur erreur" dans le menu Débogage, créer un calque quand l'erreur surviendra, l'éditeur s'ouvrira et en faisant Ctrl+F9 l'expression qui a provoqué l'erreur sera sélectionné, tu peux alors interroger les valeurs des variables pour essayer de déterminer ce qui a provoqué l'erreur.

 

Tu peux essayer aussi ave ce LISP qui crée un calque :

 

(defun c:addLayer (/ pref ind)
 (setq	pref "Calque"
ind  1
 )
 (while (tblsearch "layer" (strcat pref (itoa ind)))
   (setq ind (1+ ind))
 )
 (entmakex
   (list
     '(0 . "LAYER")
     '(100 . "AcDbSymbolTableRecord")
     '(100 . "AcDbLayerTableRecord")
     (cons 2 (strcat pref (itoa ind)))
     '(70 . 0)
     '(62 . 7)
     '(6 . "Continuous")
   )
 )
)

[ASTERIXII]

Bon, avec le programme tiers, plus de message d'erreur, mais la couleur ne passe pas à 30

Pourtant j'ai bien les 2 message, un pour le calque ajouté, et l'autre que c'est par la commande LAYER et que la couleur est modifiée.

 

Avec mon lisp de création de calque, sa marche bien, la couleur est bien modifiée.

 

Et si le programme tiers faisait la manip en plusieurs fois ?

1 création du calque ---> détection

2 modification de nouveau calque (ex la couleur)---> pas de détection

 

Pourtant dans ton premier lisp il le faisait.

 

Je cherche encore

[(gile)]

Le réacteur ne réagit qu'à la création de calque (en fait à l'ajout de tout objet dans la base de données mais n'a d'acton que si l'objet ajouté est un calque).

Il ne réagit pas lors d'une modification de calque.

Je pense que si la première fois, le réacteur s'activait deux fois, c'est parce qu'il avait été chargé deux fois.

 

C'est difficile pour moi d'en dire plus ne sachant pas ce qu'est ce "programme tiers" ni ce qu'il fait.

[ASTERIXII]

Le programme tiers est "malheuresement" un fichier fas.

Mais j'ai trouvé un moyen, car il y a une fonction debug

 

J'utilise donc une partie de ton code:

 

(setq *LayerAddedReactor* (vlr-acdb-reactor () '((:vlr-objectAppended . layerAddedCallback))))

(defun layerAddedCallback (rea obj / elst)

(setq elst (entget (cadr obj)))

(if (= (cdr (assoc 0 elst)) "LAYER")

(alert (strcat "le calque '" (cdr (assoc 2 elst)) "' a été ajouté") ) )

)

 

je remplace la boite d'alerte par 2 variables, une pour le calque et une pour le statut.

Ensuite je fais un traitement dans la zone de debug

 

Merci encore à toi pour ton aide, toujours aussi efficace !