Faire une sélection à l\'aide d\'un objet existant

[bonuscad]

Bonjours à tous,

 

En m'inspirant d'une demande fréquente pour faire une sélection à partir d'objets existants,

le plus souvent à partir d'une polyligne avec ou sans segments courbes.

J'ai essayer de construire un lisp répondant à ce besoin.

J'ai trouvé un bout de code intéressant de Bill Zondlo que j'ai adapté à mes besoin (Show_drag_circle) pour pouvoir traiter les arcs, voir à:

 

http://discussion.autodesk.com/thread.jspa?messageID=4073523

 

Le résultat, bien qu'en phase de test, à l'air convenable, mais bien sûr doit comporter encore des imperfections ou des bugs.

 

Je vous le propose, dès fois que certain d'entre vous ait envie de l'améliorer,de le remodeler ou de le tripatouiller.

Tout "feed-back" est le bienvenu.

 

Actuellement la routine accepte: ligne, arc, cercle, polylignes/lwpolyligne.

(defun def_bulg_pl (ls lb flag_closed / ls lb rad a l_new)
(if (not (zerop flag_closed)) (setq ls (append ls (list (car ls)))))
(while (cadr ls)
	(if (zerop (car lb))
		(setq l_new (append l_new (list (car ls))))
		(progn
			(setq
				rad (/ (distance (car ls) (cadr ls)) (sin (* 2.0 (atan (abs (car lb))))) 2.0)
				a (- (/ pi 2.0) (- pi (* 2.0 (atan (abs (car lb))))))
			)
			(if (< a 0.0) (setq a (- (* 2.0 pi) a)))
			(if (or (and (< (car lb) 0.0) (> (car lb) -1.0)) (> (car lb) 1.0))
				(setq l_new (append l_new (reverse (cdr (reverse (bulge_pts (polar (car ls) (- (angle (car ls) (cadr ls)) a) rad) (car ls) (cadr ls) rad (car lb)))))))
				(setq l_new (append l_new (reverse (cdr (reverse (bulge_pts (polar (car ls) (+ (angle (car ls) (cadr ls)) a) rad) (car ls) (cadr ls) rad (car lb)))))))
			)
		)
	)
	(setq ls (cdr ls) lb (cdr lb))
)
(append l_new (list (car ls)))
)
(defun bulge_pts (pt_cen pt_begin pt_end rad sens / inc ang nm p1 p2 lst)
(setq
	inc (angle pt_cen (if (< sens 0.0) pt_end pt_begin))
	ang (+ (* 2.0 pi) (angle pt_cen (if (< sens 0.0) pt_begin pt_end)))
	nm (fix (/ (rem (- ang inc) (* 2.0 pi)) (/ (* pi 2.0) 36.0)))
)
(repeat nm
	(setq
		p1 (polar pt_cen inc rad)
		inc (+ inc (/ (* pi 2.0) 36.0))
		lst (append lst (list p1))
	)
)
(setq
	p2 (polar pt_cen ang rad)
	lst (append lst (list p2))
)
(if (< sens 0.0) (reverse lst) lst)
)
(defun c:sel_by_object ( / ent dxf_ent typent closed lst l_bulg e_next key osmd opkb oapt vmin vmax minpt maxpt zt lst2 l_ent ss1 ss2 js_all tmp)
(while (null (setq ent (entsel "\nChoix de l'entité: "))))
(setq typent (cdr (assoc 0 (setq dxf_ent (entget (car ent))))))
(cond
	((eq typent "LWPOLYLINE")
		(setq
			closed (boole 1 (cdr (assoc 70 dxf_ent)) 1)
			lst (mapcar '(lambda (x) (trans x (car ent) 1)) (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) dxf_ent)))
			l_bulg (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 42)) dxf_ent))
			lst (def_bulg_pl lst l_bulg closed)
		)
	)
	((eq typent "POLYLINE")
		(setq
			closed (boole 1 (cdr (assoc 70 dxf_ent)) 1)
			e_next (entnext (car ent))
		)
		(while (= "VERTEX" (cdr (assoc 0 (setq dxf_next (entget e_next)))))
			(if (zerop (boole 1 223 (cdr (assoc 70 dxf_next))))
				(setq
					lst (cons (trans (cdr (assoc 10 dxf_next)) (car ent) 1) lst)
					l_bulg (cons (cdr (assoc 42 dxf_next)) l_bulg)
				)
			)
			(setq e_next (entnext e_next))
		)
		(setq
			lst (reverse lst)
			l_bulg (reverse l_bulg)
			lst (def_bulg_pl lst l_bulg closed)
		)
	)
	((eq typent "LINE")
		(setq
			lst (list (trans (cdr (assoc 10 dxf_ent)) 0 1) (trans (cdr (assoc 11 dxf_ent)) 0 1))
			closed 0
		)
	)
	((eq typent "CIRCLE")
		(setq
			lst
				(bulge_pts
					(trans (cdr (assoc 10 dxf_ent)) (car ent) 1)
					(polar (trans (cdr (assoc 10 dxf_ent)) (car ent) 1) 0.0 (cdr (assoc 40 dxf_ent)))
					(polar (trans (cdr (assoc 10 dxf_ent)) (car ent) 1) (- (* 2.0 pi) (/ (* pi 2.0) 36.0)) (cdr (assoc 40 dxf_ent)))
					(cdr (assoc 40 dxf_ent))
					1
				)
			lst (append lst (list (car lst)))
			closed 1
		)
	)
	((eq typent "ARC")
		(setq
			lst
				(bulge_pts
					(trans (cdr (assoc 10 dxf_ent)) (car ent) 1)
					(polar (trans (cdr (assoc 10 dxf_ent)) (car ent) 1) (cdr (assoc 50 dxf_ent)) (cdr (assoc 40 dxf_ent)))
					(polar (trans (cdr (assoc 10 dxf_ent)) (car ent) 1) (cdr (assoc 51 dxf_ent)) (cdr (assoc 40 dxf_ent)))
					(cdr (assoc 40 dxf_ent))
					1
				)
			closed 0
		)
	)
	(T (princ "\nN'est pas une Ligne, Arc, Cercle ou Polyligne!"))
)
(cond
	(lst
		(if (equal (last lst) (car lst)) (setq lst (cdr lst) closed 1))
		(setq osmd (getvar "osmode") oapt (getvar "aperture") opkb (getvar "pickbox"))
		(setvar "osmode" 0)
		(setq
			vmin (mapcar '- (getvar "viewctr") (list (/ (* (car (getvar "screensize")) (* 0.5 (getvar "viewsize"))) (cadr (getvar "screensize"))) (* 0.5 (getvar "viewsize")) 0.0))
			vmax (mapcar '+ (getvar "viewctr") (list (/ (* (car (getvar "screensize")) (* 0.5 (getvar "viewsize"))) (cadr (getvar "screensize"))) (* 0.5 (getvar "viewsize")) 0.0))
			minpt (list (eval (cons min (mapcar 'car lst))) (eval (cons min (mapcar 'cadr lst))))
			maxpt (list (eval (cons max (mapcar 'car lst))) (eval (cons max (mapcar 'cadr lst))))
		)
		(setq zt (or (< (car minpt) (car vmin)) (< (cadr minpt) (cadr vmin)) (> (car maxpt) (car vmax)) (> (cadr maxpt) (cadr vmax))))
		(if zt (command "_.zoom" "_window" minpt maxpt))
		(setvar "aperture" 1)
		(setvar "pickbox" 1)
		(if (zerop (getvar "pickfirst")) (setvar "pickfirst" 1))
		(while (car lst)
			(setq
				lst2 (cons (car lst) lst2)
				lst (vl-remove (car lst) lst)
			)
		)
		(setq lst (reverse lst2))
		(if (zerop closed)
			(setq ss1 (ssdel (car ent) (ssget "_F" lst)))
			(progn
				(initget "SPolygone CPolygone _WPolygon CPolygon")
				(setq key (getkword "\nSélection par [sPolygone/CPolygone] < CP >: "))
				(if (eq key "WPolygon")
					(setq ss1 (ssget "_WP" lst))
					(setq ss1 (ssdel (car ent) (ssget "_CP" lst)))
				)
			)
		)
		(setvar "pickbox" opkb)
		(setvar "aperture" oapt)
		(setq
			l_ent (if ss1 (ssnamex ss1))
			js_all (ssget "_X")
		)
		(foreach n l_ent (if (eq (type (cadr n)) 'ENAME) (setq ss2 (ssdel (cadr n) js_all))))
		(if (and ss1 ss2 (= 0 (getvar "CMDACTIVE"))) 
			(progn
				(princ "\n< Click+gauche > pour inverser la sélection; < Entrée >/[Espace]/Click+droit pour finir!.")
				(while (and (not (member (setq key (grread T 4 2)) '((2 13) (2 32)))) (/= (car key) 25))
					(sssetfirst nil ss1)
					(cond
						((eq (car key) 3)
							(setq tmp ss1 ss1 ss2 ss2 tmp)
						)
					)
				)
			)
		)
		(setvar "osmode" osmd)
	)
)
(prin1)
)

 

[Edité le 21/3/2006 par bonuscad]

[Serge]

Bonuscas,

 

Il n'y a rien de vraiment réjouissant à déboguer le code d'autrui lorqu'on ne connais ni les bugs, ni le contexte d'utilisation et que le code n'a aucun commentaire.

 

Serge

 

[zebulon_]

Salut,

 

c'est trop compliqué pour ma petite tête, c'est pourquoi j'aime les choses simples et les outils déjà disponibles et créés par des gens plus intelligents que moi.

 

Donc, pour sélectionner suivant un objet, je vous propose l'idée suivante :

 

1°) cliquer sur un objet

 

2°) déterminer la longueur de l'objet

 

3°) lancer la commande _measure en spécifiant une longueur de segment relative à la longueur de l'objet.

 

4°) Récupérer dans une liste les coordonnées des points créés par _measure

 

5°) Utiliser ces coordonnées pour faire la sélection

 

6°) Effacer les points créés en 3°)

 

 

[bonuscad]

Bonjour,

 

Ma demande n'était pas de debuger le code ;)

Suite aux conversations de ICI

ainsi que celle CI

J'aurais souhaité que les personnes interréssés l'essayent et fassent part de leurs observations.

 

Je n'ais pas commenté le code, c'est vrai, mais si ça interresse quelqu'un, je suis prêt à le faire!

 

Ce qui interessant à retenir, c'est que la variable "LST" contient les sommets des segments droit et pour les parties courbe un point est généré tous les 10 degré. Cette liste peut donc servir à autre chose que de déterminer les point de trajet d'une sélection..

 

Pour les bugs si j'ai besoin d'aide, alors votre aide sera la bienvenue. Mais pour l'instant je suis plutot soucieux du sens de ma démarche , si cette solution en lisp pourrait convenir, ou si je fais fausse route?

 

 

[bonuscad]

Je viens de corriger le code, car j'ai observé que des (lw)polylignes ayant des doublons dans les sommets posaient problème.

(ssget) avec une liste de points ne fonctionne pas si des points sont en doubles (tourjours bon à savoir)

 

J'ai inseré le petit bout de code de (gile) pour supprimer les doublons dans une liste.

 

Merci (gile) ;)