Déplacement SCU

[nicolas2]

Bonjour à tous,

la routine suivante effectue au

 

Démarrage :

 

1 - un zoom étendu

 

1ier click : (sur un cercle de ØX)

 

2- un nettoyage de tout sauf du type de cercle sélectionné (avec ØX)

3- la mise de ces cercles sous le calque UT1 (le crée s'il est inexistant)

4- recentre le SCU sur le centre du 1ier cercle sélectionné

5- un zoom étendu

 

2ième click et clicks suivants :

 

5- redéfinie l'ordre de tracé en numérotant les cercles

 

[surligneur] 2 Questions :[/surligneur]

 

1- Si je me trompe au 1ier lancement de la routine et que je la lance une 2ième fois, tout

se passe comme la 1ière fois, sauf que le SCU ne suis pas la modif. et reste à l'endroit

indiqué lors de la 1ière fois.

 

2- Lors du 1ier Click sur le cercle type, est-il possible de commencer la numérotation

(puisque le cercle type est aussi le tube N°1 et que le deuxième click le redésigne)

 

 

 (defun c:nettoyeur ( / ent dxf_ent js jsc n nw_js i l_dxf h)
(command "zoom" "et")
(while (null (setq ent (entsel "\nDésigner un cercle type: "))))
(setq dxf_ent (entget (car ent)))
(setq p1 (cdr (assoc 10 (entget (car ent)))))
(command "scu" "déplacer" p1 "")
(cond
((eq (cdr (assoc 0 dxf_ent)) "CIRCLE")
(setq
js (ssget "_x" (list (assoc 410 dxf_ent) (assoc 67 dxf_ent)))
jsc (ssget "_x" (list (assoc 0 dxf_ent) (assoc 410 dxf_ent) (assoc 67 dxf_ent) (assoc 40 dxf_ent)))
n -1
)
(repeat (sslength jsc)
(ssdel (ssname jsc (setq n (1+ n))) js)
)
(if (not (tblsearch "LAYER" "UT1"))
(entmake '((0 . "LAYER")
(100 . "AcDbSymbolTableRecord")
(100 . "AcDbLayerTableRecord")
(2 . "UT1")
(70 . 0)
(62 . 7)
(6 . "Continuous")
(290 . 1)
(370 . -3)
)
)
)
(if js
(repeat (setq n (sslength js))
(entdel (ssname js (setq n (1- n))))
)
)
(if jsc
(repeat (setq n (sslength jsc))
(entmod (subst '(8 . "UT1") (assoc 8 (setq dxf_ent (entget (ssname jsc (setq n (1- n)))))) dxf_ent))
)
)
)
)
(command "zoom" "et")
(setq nw_js (ssadd) i 0)
(while (setq js (ssget"_:S"))
(ssadd (ssname js 0) nw_js)
(setq l_dxf (entget (ssname js 0)))
(setq h (* (cdr (assoc 40 l_dxf)) 0.5) i (1+ i))
(entmake
(list
'(0 . "TEXT")
'(10 0. 0. 0.)
(cons 11 (cdr (assoc 10 l_dxf)))
(cons 40 h)
(cons 1 (itoa i))
'(72 . 1)
'(73 . 2)
)
)
)
(setq js (ssget "_X"))
(cond
(js
(repeat (setq n (sslength js))
(ssadd (ssname js (setq n (1- n))) nw_js)
)
)
)
(cond
(nw_js
(setq n -1)
(repeat (sslength nw_js)
(entmake (setq l_dxf (entget (ssname nw_js (setq n (1+ n))))))
(entdel (cdar l_dxf))
)
)
)
(prin1)
) 

 

Merci à tous pour votre aide (la routine ci-dessus m'a été grandement soufflée par des CADXpiens)

[Patrick_35]

Salut

 

J'aurai quelques remarques si tu le permets.

 

1) Ta boucle de sélection ne sert à rien, car si tu choisis une ligne, cela fonctionne aussi

Un exemple pour ne sélectionner que des cercles.

(while (not ent)
 (princ "\nDésigner un cercle type: ")
 (setq ent (ssget "_:S" '((0 . "CIRCLE"))))
)
(setq ent (ssname ent 0))

 

2) Il est surprenant de se servir d'un cond comme d'un if

Si tu as besoins de plusieurs arguments après le if, utilise progn

 

Exemple

(if (eq (cdr (assoc 0 dxf_ent)) "CIRCLE")
 (progn
   ...
   ...
 )
)

 

Comme on est dans la section Pour aller plus loin en LISP, tu peux aussi utiliser le and comme condition if

Le and continuera tant que les conditions qui se suivent sont remplit

 

Exemple

(and (eq (cdr (assoc 0 dxf_ent)) "CIRCLE")
 (setq js  (ssget "_x" (list (assoc 410 dxf_ent) (assoc 67 dxf_ent)))
jsc (ssget "_x" (list (assoc 0 dxf_ent)
		      (assoc 410 dxf_ent)
		      (assoc 67 dxf_ent)
		      (assoc 40 dxf_ent)
	        )
    )
n -1
 )
 ...
 ...
)
)

 

3) Utilise les commandes en version internationale

(command "zoom" "et") donne en international (command "_.zoom" "_e")

(command "scu" "déplacer" p1 "") donne (command "_.ucs" "_move" p1 "")

 

4) Inutile de tester si le calque "UT1" existe ou pas. Dans la commande _.layer, l'option _make créé le calque. S'il existe, rien ne change et pas de message d'erreur.

 

5) Je vois que tu crées deux jeux de sélection. Un premier qui contient tous les cercles et un second, que des cercles d'un certain rayon (ps : le code 67, tel qu'il est employé = code 410).

Sur ce premier jeu, tu soustrais le second pour ensuite effacer le premier.

Tu peux simplifier en parcourant un seul jeu de sélection, de regarder le rayon et si c'est ok, de conserver l'objet dans un nouveau jeu de sélection, sinon l'effacer.

 

6) Je constate que tu crées des textes suivant une certaine sélection.

Tu n'as pas de tri ? car autocad lui seul connaît l'ordre de la sélection.

 

7) Tu n'utilises pas la commande _undo, ce qui permet les erreurs de saisie.

 

8) Tu n'utilises pas la variable cmdecho pour effacer les messages des command.

 

9) Ce serait bien d'ajouter du texte pour indiquer, lors de tes sélections, ce qu'il faut faire. Pour l'instant, tu as le lisp en tête, mais dans 6 mois, quid ?

 

Je me suis arrêté à la lecture de ton lisp avant les créations de tes textes car j'ai plein de choses à faire. ;)

 

@+

[nicolas2]

Merci Patrick_35 !

j'évolue doucement dans le monde du lisp, j'espère pouvoir effectuer une formation pour réellement mieux comprendre ce language. Merci pour ton aide.

Pourrais-tu m'aider à solutionner mes problèmes ?

 

Merci encore à tous

[nicolas2]

Bonjour à tous,

 

le code paraît bon mais le SCU ne se recentre pas sur p1 si je relance une seconde fois la routine ? :casstet:

 

 (setq p1 (cdr (assoc 10 (entget (car ent)))))
(command "scu" "déplacer" p1 "")

 

Merci pour votre aide

[nicolas2]

 (command "_ucs" "_move" (trans p1 0 1) "")