sélection par polygone

bseb67 · le 13 janvier 2009

Salut!

Pour un de mes lisps, j'aimerai pouvoir faire une sélection par polygone.

J'ai essayé ceci:

(command "_select" "_cp") mais le problème c'est que le lisp continu sans attendre que

la sélection soit finie :mad:

La fonction ssget, en entrant l'option cp dans "choix des objets" lance la sélection par polygone.

Mais je ne veux pas que l'utilisateur tape le cp. Et le (ssget "_cp") attend comme 2ème argument

la liste des points.

J'ai trouvé quelque chose qui pourrai aller, mais je ne souhaites pas l'utiliser, car c'est une fonction

des express tools:

(acet-ui-polygon-select flag) avec flag: 0 si trait plein ou autre si trait en tiret.

Cette fonction demande les points du polygone et les renvoie simplement.

une fonction équivalente me conviendrai aussi, afin de l'envoyer dans le ssget

Merci.

Tramber · le 13 janvier 2009

Si tu es débutant :

(setq p (getpoint))

(command "_pline" p (while p (command (setq p (getpoint p)))))

Est une (vieille) astuce pour créer une liste de point.

Je n'ai que qu'une minute pour te répondre. Pas de quoi me creuser la tête. En attendant, tu trace la poly, récupères les points et l'efface.

Ou alors tu adaptes.....

Mais quelqu'un t'apporteras une réponse plus approprié car à, j'ai la mémoire au fond du sac !

Patrick_35 · le 13 janvier 2009

Salut

J'ai essayé ceci et ça fonctionne corectement

(setq az (ssget "cp" (list '(0.0 0.0) '(10.0 0.0) '(10.0 10.0) '(0.0 10.0))))
(terpri)(princ (sslength az))(princ)

bseb67 · le 13 janvier 2009

Tramber: ce n'est pas vraiment ca que je cherche.

Patrick_35: je pensais que terpri serai une fonction miracle, mais en fait non :( .

Oui je sais qu'un (ssget "_cp" suivi_d_une_liste_de_points) marche, mais ce n'est pas tout à fait ca.

L'utilisateur doit choisir les objets, d'abord je lançai un menu demandant si capture ou si polygone,

et boucler là-dessus afin de permettre à l'utilisateur d'annuler la dernière sélection.

Mais je crois que je vais simplement lancer un ssget, stocker les objets choisis, trouver la zone

graphique concernée pour faire un zoom sur la sélection au cas ou.

bonuscad · le 13 janvier 2009

Et comme ceci?

((lambda ( / pt lst_pt)
 (while (setq pt (if (car lst_pt) (getpoint (car lst_pt) "\nPoint suivant?: ") (getpoint "\nPoint?: ")))
   (if (car lst_pt) (grdraw (car lst_pt) pt 7))
   (setq lst_pt (cons pt lst_pt))
   (initget 32)
 )
 (if (> (length lst_pt) 2) (sssetfirst nil (ssget "_CP" lst_pt)))
 (prin1)
))

Tramber · le 13 janvier 2009

Ah ben ouais, pas besoin de polyligne :cool:

bonuscad · le 13 janvier 2009

Et plus simplement, en fait ....

((lambda ( / )
(command "_.select" "_cp")
 (while (not (zerop (getvar "cmdactive")))
   (command pause)
)
(command "_.erase" "_previous" "")
))

Tramber · le 13 janvier 2009

Oui alors, le coup du cmdactive j'y ai pensé mais j'osais pas :hallucine:

Ya pas photo. Il manque un "" dans le _erase mais bon....

bseb67 · le 13 janvier 2009

Re,

En fait je cherchai a reproduire la même chose que (command "_select" "_cp"), mais je viens

de faire un truc à ma sauce. Et étant un peu tordu, j'ai voulu tester un truc, qui bien-sur devrai

ne pas être valable mais marche quand même. Etant curieux, j'ai fait la même chose avec select,

et bien......

Il y a le même bug :D

faites un triangle, et pour le 4 ème, si on croise le polygone, autocad nous jette en disant

qu'il ne faut croiser, mais si vous alignez le 3ème point avec le 1er et le 4ème, et bien ca marche.

Je vais mettre mon code en plus jolie forme, et le poserai plus tard.

merci encore.

bseb67 · le 14 janvier 2009

Bon, voilà ma petite sauce, la fonction renvoie uniquement une liste de points,

il faut donc faire ainsi:

(if (= (type (setq lp (get_polygone_de_selection 1))) 'LIST)

(setq sel (ssget "_cp" lp))

)

; VARIABLES GLOBALES
(setq
VAR_EPSILON 1e-6

; codes touches clavier
VAR_KEYBOARD_ENTER 13
VAR_KEYBOARD_SPACE 32
VAR_KEYBOARD_F3     6
VAR_KEYBOARD_F4    20
VAR_KEYBOARD_F5     5
VAR_KEYBOARD_F6     4
VAR_KEYBOARD_F7     7
VAR_KEYBOARD_F8    15
VAR_KEYBOARD_F9     2
VAR_KEYBOARD_F10   21
VAR_KEYBOARD_F11   23
VAR_KEYBOARD_F12   31
)

;--------------------------------------;
; nom: get_polygone_de_selection       ;
; role: renvoie les coordonnées des    ;
;       points formant un polygone que ;
;       l'utilisateur saisi à l'écran  ;
;       par la souris                  ;
; param: flag => style d'affichage pour;
;                la sélection:         ;
;                0 -> fenêtre          ;
;                autre -> capture      ;
; retour: une liste de points 3D       ;
;         -1 si échap                  ;
;         nil si erreur                ;
; date: 13/01/2009                     ;
; BLAES Sébastien                      ;
;--------------------------------------;
(defun get_polygone_de_selection( flag / fonc_name res loop plist end_msg msg gr poly pt vla_obj)
(setq fonc_name "get_polygone_de_selection: "
      res nil
      loop T
      plist '()
      end_msg "Point (Clic)[gauche ajout/ droit retrait]:"
      msg (strcat "Premier " end_msg)
)
 
(while (= loop t)
	(cond
	  	; gestion de la touche échap
	  	((= (vl-catch-all-error-p (setq gr (vl-catch-all-apply 'grread (list T 8 0)))) t)
		 	(setq loop -1
			      res -1)
		 	(and poly (/= (entget poly) nil) (entdel poly) (setq poly nil))
		)
		(t
		 	; on construit le message à afficher
		 	(cond
			  	((= (length plist) 0)
				 	(setq msg (strcat "1er " end_msg))
				)
				((> (length plist) 0)
				 	(setq msg (strcat (itoa (1+ (length plist))) "ème " end_msg))
				)
				(t
				 	(setq msg end_msg)
				)
			) ; cond

		 	; on test si on doit ré-afficher le message
		  	(if (/= msg (getvar "lastprompt"))
			  	(progn
				  	(setq lastprompt (append lastprompt (list (getvar "lastprompt"))))
			  		(princ (strcat "\n" msg))
				  	(princ)
				) ; progn
			) ; if

		 	; on supprime la polyligne s'il le faut
			(and poly (/= (entget poly) nil) (entdel poly) (setq poly nil))

			(setq pt (cadr gr))
			(cond
			  	; mouvement souris
				((= (car gr) 5)
				 	(cond
					  	((> (length plist) 0)
							(setq poly (entmakex (append (list '(0 . "LWPOLYLINE")
											   '(100 . "AcDbEntity")
											   '(100 . "AcDbPolyline")
											   ; nombre de point
											   (cons 90 (1+ (length plist)))
											   ; largeur de la polyligne
											   (cons 43 0.0)
											   (cons 70 1))
										     ; mapcar pour les sommets
										     (mapcar '(lambda (x) (cons 10 x)) (append plist (list pt))))))

						 	; on test le flag, si c'est différent de 0, on highlight la polyligne
						 	; pour mettre en tiret les lignes de la polyligne
						 	(cond
							  	((= flag 0)
								)
								((= poly nil)
								)									
							  	((/= (type (setq vla_obj (vlax-ename->vla-object poly))) 'VLA-OBJECT)
								)
								(t
						 			(vla-Highlight vla_obj :vlax-true)
								)
							) ; cond
						)
						(t
						 	(setq poly nil)
						)
					) ; cond
				)

				; clic gauche
				((= (car gr) 3)

				 	(cond
					 	; on test si pt n'appartient pas à plist
					 	((/= (apply '+ (mapcar '(lambda (point_to_test) (if (= (equal pt point_to_test VAR_EPSILON) t) 1 0)) plist)) 0)
						  	(princ (strcat fonc_name "ERREUR ce point à déjà été choisi"))
						)
						; on test s'il n'y a pas d'intersection entre la ligne que l'on veut créer et celles formées par plist
						((= (check_intersection plist pt) t)
						 	(print "croisement")
						)
						(t
						 	(setq plist (append plist (list pt)))
						 	
						)
					) ; cond
				)

				; clic droit
				((= (car gr) 25)
				 	(princ (strcat "\nAnnulation du dernier point saisi."))
				 	(princ)
				 	(setq plist (vl-remove (last plist) plist))
				)

				; on gère le clavier
				((= (car gr) 2)
				 	(cond
					  	((or (= pt VAR_KEYBOARD_ENTER)
						     (= pt VAR_KEYBOARD_SPACE))

						 	; on fini la boucle
						 	; et on stocke la liste des points
						 	(setq loop nil
							      res plist
							) ; setq
						)							
						(t
						 	(princ (strcat "\nCette touche du clavier est non gérée."))
						 	(princ)
						)
					) ; cond
				)
				(T
				 	(setq res nil
					      loop nil)
				)
			) ; cond	
		)
	) ; cond
) ; while

 	(princ "\n")
 	res
) ; get_polygone_de_selection

;------------------------------------------;
; nom: check_intersection                  ;
; role: test si la ligne allant du premier ;
;       point contenu dans list_pt à pt ou ;
;       la ligne allant du dernier point à ;
;       pt ne croisent pas une des lignes  ;
;       formées par deux points consécutifs;
;       de list_pt :                       ;
;       list_pt(i) et list_pt(i+1)         ;
; param: list_pt => liste de points 3D     ;
;        pt => point 3D                    ;
; retour: t si croisement                  ;
;         nil sinon                        ;
; date: 13/01/2009                         ;
; BLAES Sébastien                          ;
;------------------------------------------;
(defun check_intersection( list_pt pt / fonc_name res list_pt_tmp p_start p_end)
 	(setq fonc_name "check_intersection: "
      res nil
      list_pt_tmp list_pt
      p_start (car list_pt)
      p_end (last list_pt))

 	(cond
  	; il doit y avoir au moins 3 points dans list_pt_tmp sinon il n'y a pas intersection
  	((or (= list_pt_tmp nil)
	     (< (length list_pt_tmp) 3))
	)
	(t
	 	; on va boucler sur la liste, afin de tester si les lignes pt-p_start ou pt-p_end
	 	; ne croisent pas une autre ligne formée des points list_pt_tmp(i) list_pt_tmp(i+1)
	 	(while (and (= res nil)
			    (> (length list_pt_tmp) 1))

			(if (or (= (croisement_lignes (car list_pt_tmp) (cadr list_pt_tmp) pt p_start) t) ; on test si la ligne ligne_tmp croise pt-p_start
				(= (croisement_lignes (car list_pt_tmp) (cadr list_pt_tmp) pt p_end) t)) ; on test si la ligne ligne_tmp croise pt-p_end
			  	(setq res t)
			) ; if
		  
		  	; on retire le premier élément de la liste temporaire de travail
		  	(setq list_pt_tmp (cdr list_pt_tmp))
		) ; while
	)
) ; cond
 	
 	res
) ; check_intersection

;--------------------------------------;
; nom: croisement_lignes               ;
; role: test si la ligne P11-P12 croise;
;       la ligne P21-P22               ;
; param: P11 => point 3D n°1 ligne 1   ;
;        P12 => point 3D n°2 ligne 1   ;
;        P21 => point 3D n°1 ligne 2   ;
;        P22 => point 3D n°2 ligne 2   ;
; retour: t si croisement              ;
;         nil sinon                    ;
; date: 13/01/2009                     ;
; BLAES Sébastien                      ;
;--------------------------------------;
(defun croisement_lignes( P11 P12 P21 P22 / fonc_name res inter)
 	(setq fonc_name "croisement_lignes: "
      res nil)

 	;on charge la calculatrice géométrique si besoin
 	(if (not (member "geomcal.arx" (arx))) (arxload "geomcal.arx"))

 	(cond
  	; on test s'il y a intersection
  	((= (setq inter (cal "ill(P11, P12, P21, P22)")) nil)
	)
			
	; s'il y en a une, on vérifie que ce n'est pas P11
	((= (equal inter P11 VAR_EPSILON) t)
	)
	; s'il y en a une, on vérifie que ce n'est pas P12
	((= (equal inter P12 VAR_EPSILON) t)
	)
	; s'il y en a une, on vérifie que ce n'est pas P21
	((= (equal inter P21 VAR_EPSILON) t)
	)
	; s'il y en a une, on vérifie que ce n'est pas P22
	((= (equal inter P22 VAR_EPSILON) t)
	)

	; il faut vérifier aussi si inter se trouve bien sur les segments [P11-P12] et [P21-P22]
	((and (= (compris_entre_2D inter P11 P12) t)
	      (= (compris_entre_2D inter P21 P22) t))
	 	; c'est bien une intersection
	 	(setq res t)
	)
) ; cond
 
 	res
) ; croisement_lignes

;------------------------------------;
; nom: compris_entre_2D              ;
; role: test si le point p_test est  ;
;       compris entre les coordonnées;
;       de L_p1 et L_p2              ;
; param: p_test => point 3D à tester ;
;        L_p1 => premier point       ;
;        L_p1 => deuxième point      ;
; retour: t si vrai                  ;
;         nil sinon                  ;
; date: 11/03/2008                   ;
; BLAES Sébastien                    ;
;------------------------------------;
(defun compris_entre_2D( p_test L_p1 L_p2 / fonc_name xt yt x1 y1 x2 y2)
 	(setq fonc_name "compris_entre_2D: "
      res nil)

 	(cond
	; p_test
	((= (setq xt (car p_test)) nil)
	 	
	)
	((= (setq yt (cadr p_test)) nil)
	 	
	)

	; L_p1
	((= (setq x1 (car L_p1)) nil)
	 	
	)
	((= (setq y1 (cadr L_p1)) nil)
	 	
	)

	; L_p2
	((= (setq x2 (car L_p2)) nil)
	 	
	)
	((= (setq y2 (cadr L_p2)) nil)
	 	
	)

	
	((and (or (<= x1 xt x2)
		  (<= x2 xt x1))
	      (or (<= y1 yt y2)
		  (<= y2 yt y1)))
	      (setq res t)
	)
) ; cond

res
 
) ; compris_entre

Voilà.

[Edité le 14/1/2009 par bseb67]

Connexion

sélection par polygone

Messages recommandés

bseb67

Tramber

Patrick_35

bseb67

bonuscad

Tramber

bonuscad

Tramber

bseb67

bseb67

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Forums

Naviguer

Activité

Information importante