Simplifier une macro

[Arcasdk]

Bonjour à tous,

 

Toujours dans un souci de dessiner plus rapidement en évitant de balader la souris sur le mètre d'écran que je possède en cherchant désespérément le bouton, j'utilise une petite macro qui change le calque des entités sélectionnées via des noms de commande qui sont des numéros. Ma main quitte donc la souris 1 seconde et le tour est joué.

 

Le problème c'est que cette macro s'allonge au fil du temps mais je pense qu'elle peut désormais se raccourcir en utilisant des fonctions telles que "foreach" ou peut être "mapcar". Des fonctions que je ne maîtrise pas encore bien.

 

Voici un bout de mon code. Vous comprendrez que j'ai le même paragraphe pour chaque commande.

 

 

(setq C0 "0")
(setq C1 "AXES")
(setq C2 "CACHE")
(setq C3 "CARTOUCHE")
(setq C4 "COTATION")
(setq C5 "FIN")
(setq C6 "HACHURES")
(setq C7 "TEXTE")
(setq 0p "PIPE")
(setq 0e "Existant")
(setq 0f "Fittings")

;Mettre le jeu de sélection dans le calque 0;
(defun c:0 (/ doc js sel)
 (vl-load-com)
 (setq doc (vla-get-activedocument (vlax-get-acad-object)))
 (vla-startundomark doc)
 (vl-catch-all-apply 'vla-add (list (vla-get-layers doc) C0))
 (and (setq js (ssget))
   (progn
     (vlax-for ent (setq sel (vla-get-activeselectionset doc))
(vla-put-layer ent C0)
(vla-put-color ent 256)
(vla-put-linetype ent "ByLayer")
(vla-put-lineweight ent "-1")
     )
     (vla-delete sel)
   )
 )
 (sssetfirst nil js)
 (vla-endundomark doc)
 (command "regen")
 (princ)
)

;Mettre le jeu de sélection dans le calque AXE
(defun c:1 (/ doc js sel)
 (vl-load-com)
 (setq doc (vla-get-activedocument (vlax-get-acad-object)))
 (vla-startundomark doc)
 (vl-catch-all-apply 'vla-add (list (vla-get-layers doc) C1))
 (and (setq js (ssget))
   (progn
     (vlax-for ent (setq sel (vla-get-activeselectionset doc))
(vla-put-layer ent C1)
(vla-put-color ent 256)
(vla-put-linetype ent "ByLayer")
     )
     (vla-delete sel)
   )
 )
 (sssetfirst nil js)
 (vla-endundomark doc)
 (command "regen")
 (princ)
)

etc... etc... etc... pour chaque "setq" en début de macro

 

Merci de m'orienter.

 

Bonne journée

[Tramber]

Salut,

(defun truc (calq / doc js sel)
 (vl-load-com)
 (setq doc (vla-get-activedocument (vlax-get-acad-object)))
 (vla-startundomark doc)
 (vl-catch-all-apply 'vla-add (list (vla-get-layers doc) calq))
 (and (setq js (ssget))
   (progn
     (vlax-for ent (setq sel (vla-get-activeselectionset doc))
       (vla-put-layer ent calq)
       (vla-put-color ent 256)
       (vla-put-linetype ent "ByLayer")
       (vla-put-lineweight ent "-1")
     )
     (vla-delete sel)
   )
 )
 (sssetfirst nil js)
 (vla-endundomark doc)
 (command "regen")
 (princ)
)

(defun c:0()  (truc "0"))
(defun c:1()  (truc "Axes"))
......

Devrait suffire et fonctionner...

[(gile)]

Salut,

 

Je suis d'accord avec Tramber, la première chose à faire quand plusieurs fonctions (ou commandes) utilisent le même code à quelques arguments prêts, c'est extraire une fonction avec arguments qui pourra être appelée par les différentes commandes, on appelle ça une "factorisation".

 

Outre le fait qu'on a considérablement réduit le nombre de ligne de code, ceci facilite la maintenance : les modifications de la routine truc se répercuteront sur toutes les commandes.

Par exemple, on pourrait faire quelques optimisations : ne rien faire s'il n'y a pas de jeu de sélection, tester si le calque existe plutôt que de faire un passage en force avec vl-catch-all-apply, appeler vla-Regen plutôt que la commande.

 

(defun truc (calq / doc js sel)
 (vl-load-com)
 (if (setq js (ssget))
   (progn
     (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
     (vla-StartUndoMark doc)
     (if (null (tblsearch "LAYER" calq))
(vla-add (vla-get-Layers doc) calq)
     )
     (vlax-for	ent (setq sel (vla-get-ActiveSelectionSet doc))
(vla-put-Layer ent calq)
(vla-put-Color ent 256)
(vla-put-Linetype ent "ByLayer")
(vla-put-Lineweight ent acLnWtByLayer)
     )
     (vla-Delete sel)
     (sssetfirst nil js)
     (vla-Regen doc acActiveViewport)
     (vla-EndUndoMark doc)
   )
 )
 (princ)
)

[Arcasdk]

Ah oui...... donc finalement ni de foreach ou de mapcar.....

 

Ça fonctionne. Merci beaucoup

[Arcasdk]

Merci (gile) pour l'optimisation et les précisions de langage. Je prends note. Vos réponses sont riches et très intéressantes.

 

Quelle est la différence entre

 

(vla-put-Lineweight ent acLnWtByLayer)

et

 

(vla-put-lineweight ent "-1")

 

Merci

[(gile)]

Quelle est la différence entre

 

(vla-put-Lineweight ent acLnWtByLayer)

et

(vla-put-lineweight ent "-1")

 

Il n'y en a pas.

(vla-put-lineweight ent -1)

marcherait aussi de la même façon.

 

La valeur à passer à la propriété Lineweight doit être un membre de l'énumération acLineWeight (voir l'aide).

Or tout membre d'une énumération correspond à un entier différent, tu peux tester dans l'éditeur Visual LISP en sélectionnant acLnWtByLayer (ou tout autre membre de l'énumération) et en ouvrant la fenêtre "Inspecter" (Ctrl+Maj+I ou le bouton avec un microscope).

Je trouve juste que acLnWtByLayer est un peu plus explicite que -1, tout comme acLnWtByBlock l'est plus que -2 ou acLnWtByLwDefault plus que -3.

[VDH-Bruno]

Bonjour

 

Ah oui...... donc finalement ni de foreach ou de mapcar.....

 

Ça fonctionne. Merci beaucoup

 

Non effectivement il ni en pas l'utilité si vraiment tu voulais utiliser mapcar, ce serai après cette première factorisation. Comme montré dans ce sujet.

 

En effectuant une seconde factorisation, sur la séquence de déclaration de commande

(defun c:C0()  (truc "0"))
(defun c:C1()  (truc "AXES"))
(defun c:C2()  (truc "CACHE"))
(defun c:C3()  (truc "CARTOUCHE"))
(defun c:C4()  (truc "COTATION"))
(defun c:C5()  (truc "FIN"))
(defun c:C6()  (truc "HACHURES"))
(defun c:C7()  (truc "TEXTE"))
(defun c:0p()  (truc "PIPE"))
(defun c:0e()  (truc "Existant"))
(defun c:0f()  (truc "Fittings"))
....

 

Comme ceci, pour créer tes fonctions à la volé:

(mapcar '(lambda (f v) (eval (list 'defun f nil (list 'truc v))))
       '(c:C0 c:C1 c:C2 c:C3 c:C4 c:C5 c:C6 c:C7 c:0p c:0e c:0f)
       '("0" "AXES" "CACHE" "CARTOUCHE" "COTATION" "FIN" "HACHURES" "TEXTE" "PIPE" "Existant" "Fittings")
)

 

A+

[Arcasdk]

Merci à tous