spécial sélection

[(gile)]

Je rassemble ici des routines, dans des versions plus abouties, qui me semblent pouvoir être utiles. Elles sont issues de sujets traités ici et là.

 

Ces routines fonctionnent désormais quelques soient le SCU courant et le SCO des objets, elle agissent suivant la vue courante comme les sélections par fenêtre ou capture.

 

La première permet de faire un jeu de sélection avec les objets qui se trouvent à l'intérieur (ou capturés par) d'une entité fermée (cercle, ellipse, polyligne).

Elle nécessite trois arguments :

- le nom d'entité (ename) de l'objet servant à faire la sélection

- une option "Cp" ou "Wp" (pour capture ou fenêtre)

- un filtre de sélection (type liste ssget) ou nil

 

Version du 06/10/06 (bug en 3D réparé)

 

;;; SelByObj -Gilles Chanteau- 06/10/06
;;; Crée un jeu de sélection avec tous les objets contenus ou 
;;; capturés, dans la vue courante, par l'objet sélectionné
;;; (cercle, ellipse, polyligne fermée).
;;; Arguments :
;;; - un nom d'entité (ename) 
;;; - un mode de sélection (Cp ou Wp)
;;; - un filtre de sélection ou nil

(defun SelByObj	(ent opt fltr / obj dist n lst prec dist p_lst)
 (vl-load-com)
 (setq obj (vlax-ename->vla-object ent))
 (cond
   ((member (cdr (assoc 0 (entget ent))) '("CIRCLE" "ELLIPSE"))
    (setq dist	(/ (vlax-curve-getDistAtParam
	     obj
	     (vlax-curve-getEndParam obj)
	   )
	   50
	)
   n	0
    )
    (repeat 50
      (setq
 lst
  (cons
    (trans
      (vlax-curve-getPointAtDist obj (* dist (setq n (1+ n))))
      0
      1
    )
    lst
  )
      )
    )
   )
   (T
    (setq p_lst (vl-remove-if-not
	   '(lambda (x)
	      (or (= (car x) 10)
		  (= (car x) 42)
	      )
	    )
	   (entget ent)
	 )
    )
    (while p_lst
      (setq
 lst (append
       lst
       (list (trans (append (cdr (assoc 10 p_lst))
			    (list (cdr (assoc 38 (entget ent))))
		    )
		    ent
		    1
	     )
       )
     )
      )
      (if (/= 0 (cdadr p_lst))
 (progn
   (setq prec (1+ (fix (* 50 (abs (cdadr p_lst)))))
	 dist (/ (- (if	(cdaddr p_lst)
		      (vlax-curve-getDistAtPoint
			obj
			(trans (cdaddr p_lst) ent 0)
		      )
		      (vlax-curve-getDistAtParam
			obj
			(vlax-curve-getEndParam obj)
		      )
		    )
		    (vlax-curve-getDistAtPoint
		      obj
		      (trans (cdar p_lst) ent 0)
		    )
		 )
		 prec
	      )
	 n    0
   )
   (repeat (1- prec)
     (setq
       lst (append
	     lst
	     (list
	       (trans
		 (vlax-curve-getPointAtDist
		   obj
		   (+ (vlax-curve-getDistAtPoint
			obj
			(trans (cdar p_lst) ent 0)
		      )
		      (* dist (setq n (1+ n)))
		   )
		 )
		 0
		 1
	       )
	     )
	   )
     )
   )
 )
      )
      (setq p_lst (cddr p_lst))
    )
   )
 )
 (ssget (strcat "_" opt) lst fltr)
) 

 

Elle peut être utilisée dans d'autre LISP ou plus directement avec ce type de fonction d'appel.

(supprimer les espaces entre

 

;;; SSOC pour sélectionner tous les objets capturés, suivant
;;; la vue, par le cercle, l'ellipse ou la polyligne.

(defun c:ssoc (/ ss opt)
 (sssetfirst nil nil)
 (if (setq ss (ssget "_:S:E"
	      (list
		'(-4 . "[color=#CC0000]			'(0 . "CIRCLE")
		'(-4 . "[color=#CC0000]			'(0 . "ELLIPSE")
		'(41 . 0.0)
		(cons 42 (* 2 pi))
		'(-4 . "AND>")
		'(-4 . "[color=#CC0000]			'(0 . "LWPOLYLINE")
		'(-4 . "&")
		'(70 . 1)
		'(-4 . "AND>")
		'(-4 . "OR>")
	      )
       )
     )
   (sssetfirst
     nil
     (ssdel (ssname ss 0) (SelByObj (ssname ss 0) "Cp" nil))
   )
 )
 (princ)
)

;;; SSOF pour sélectionner tous les objets contenus, suivant
;;; la vue, dans le cercle, l'ellipse ou la polyligne.

(defun c:ssof (/ ss opt)
 (sssetfirst nil nil)
 (if (setq ss (ssget "_:S:E"
	      (list
		'(-4 . "[color=#CC0000]			'(0 . "CIRCLE")
		'(-4 . "[color=#CC0000]			'(0 . "ELLIPSE")
		'(41 . 0.0)
		(cons 42 (* 2 pi))
		'(-4 . "AND>")
		'(-4 . "[color=#CC0000]			'(0 . "LWPOLYLINE")
		'(-4 . "&")
		'(70 . 1)
		'(-4 . "AND>")
		'(-4 . "OR>")
	      )
       )
     )
   (sssetfirst nil (SelByObj (ssname ss 0) "Wp" nil))
 )
 (princ)
) 

 

Un autre exemple d'utilisation ici.

 

SelByObj sert aussi pour cette autre routine, qui permet de sélectionner une polyligne fermée en spécifiant un point à l'intérieur de celle-ci.

 

;;; SelPlineByPoint -Gilles Chanteau- 05/10/06
;;; Sélectionne une entité fermée par un point à l'intérieur
;;; Retourne un nom d'entité (ename) ou un message d'erreur

(defun SelPlineByPoint
      (pt / size vdir inc rad loop pick circle ss ent x_lst)
 (setq	size (getvar "VIEWSIZE")
vdir (trans (getvar "VIEWDIR") 1 0)
inc  (/ size 200)
rad  inc
loop T
 )
 (entmake
   (list '(0 . "LINE")
  (cons 10 (trans pt 1 0))
  (cons 11 (trans pt 1 0))
   )
 )
 (setq pick (entlast))
 (while loop
   (if	(      (setq loop nil)
   )
   (entmake (list '(0 . "CIRCLE")
	   (cons 10 (trans pt 1 vdir))
	   (cons 40 rad)
	   (cons 210 vdir)
     )
   )
   (setq circle (entlast))
   (if	(setq ss (SelByObj circle
		   "Cp"
		   '((0 . "LWPOLYLINE") (-4 . "&") (70 . 1))
	 )
)
     (progn
(foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
  (if (member ent x_lst)
    (ssdel ent ss)
  )
)
(if
  (setq ent (ssname ss 0))
   (if
     (SelByObj ent
	       "Wp"
	       (list '(0 . "LINE")
		     (cons 10 (trans pt 1 0))
		     (cons 11 (trans pt 1 0))
	       )
     )
      (setq loop nil)
      (setq x_lst (cons ent x_lst))
   )
)
     )
   )
   (entdel circle)
   (setq rad (+ rad inc))
 )
 (entdel pick)
 ent
) 

 

Un exemple de fonction d'appel :

 

(defun c:selp (/ pt)
 (sssetfirst nil nil)
 (initget 1)
 (setq	pt (getpoint
     "\nSpécifiez un point à l'intérieur de la polyligne: "
   )
 )
 (if (setq ent (SelPlineByPoint pt))
   (sssetfirst nil (ssadd ent))
   (princ "\nPas polyligne trouvée.")
 )
 (princ)
) 

 

Un autre exemple d'utilisation ici.

 

 

[Edité le 6/10/2006 par (gile)]

[(gile)]

Il y avait un bug dans SelByObj avec les polylignes en vue 3D dans un SCU différent du SCO, le LISP a été modifié.

[(gile)]

Je continue à rassembler ici d'autres routines pour faire des jeux de sélection.

 

Sélections de tous les objets du dessin ayant une propriété commune avec l'objet sélectionné

 

;; Sélection par calque
(defun c:ssl (/ ent)
 (and
   (setq ent (car (entsel)))
   (sssetfirst nil (ssget "_X" (list (assoc 8 (entget ent)))))
 )
 (princ)
)

;; Sélection par type d'entité
(defun c:sse (/ ent)
 (and
   (setq ent (car (entsel)))
   (sssetfirst nil (ssget "_X" (list (assoc 0 (entget ent)))))
 )
 (princ)
)

;; Sélection par couleur
(defun c:ssc (/ ent col)
 (and
   (setq ent (car (entsel)))
   (or	(setq col (assoc 62 (entget ent)))
(setq col (cons 62 256))
   )
   (sssetfirst nil (ssget "_X" (list col)))
 )
 (princ)
)

;; Sélection par type de ligne
(defun c:sstl (/ ent tl)
 (and
   (setq ent (car (entsel)))
   (or	(setq tl (assoc 6 (entget ent)))
(setq tl (cons 6 "BYLAYER"))
   )
   (sssetfirst nil (ssget "_X" (list tl)))
 )
 (princ)
) 

 

 

Sélection avec fenêtre parallèle au SCU courant

 

;; SSCU (gile) 31/03/07
;; Sélection mutiple par cible, fenêtre ou capture
;; Le cadre de la fenêtre est parallèle au plan du SCU courant
;; La sélection est terminée en faisant Entrée, Espace ou clic droit

(defun c:sscu (/ sel sst loop p1 gr p2 p3 p4 po ss n ent)

 (defun ssd_err (msg)
   (if	(= msg "Fonction annulée")
     (princ)
     (princ (strcat "\nErreur: " msg))
   )
   (sssetfirst nil nil)
   (redraw)
   (setq *error* m:err
  m:err	nil
   )
   (princ)
 )

 ;; Retourne un jeu de sélection, un point ou nil
 (defun sel (/ loop gr pt)
   (setq loop T)
   (while (and (setq gr (grread T 12 2)) (/= (car gr) 3) loop)
     (cond
((= (car gr) 5)
 (setq pt (cadr gr))
)
((or (member gr '((2 13) (2 32)))
     (or (= (car gr) 11) (= (car gr) 25))
 )
 (setq loop nil
       pt   nil
 )
)
     )
   )
   (if	pt
     (cond
((ssget pt))
(pt)
     )
   )
 )

 (setq	m:err	*error*
*error*	ssu_err
 )
 (sssetfirst nil nil)
 (setq sst (ssadd))
 (while (and
   (princ "\nChoix des objets: ")
   (setq p1 (sel))
 )
   (if	(listp p1)
     (progn
(princ "\nSpécifiez le coin opposé: ")
(setq p1 (list (car p1) (cadr p1)))
(while (and (setq gr (grread T 12 0)) (/= (car gr) 3))
  (if (= 5 (car gr))
    (progn
      (redraw)
      (setq p2 (list (caadr gr) (cadr p1))
	    p3 (list (caadr gr) (cadadr gr))
	    p4 (list (car p1) (cadadr gr))
      )
      (if (		(progn
	  (setq po "_WP")
	  (grvecs (list 255 p1 p2 255 p2 p3 255 p3 p4 255 p4 p1)
	  )
	)
	(progn
	  (setq po "_CP")
	  (grvecs
	    (list -255 p1 p2 -255 p2 p3 -255 p3 p4 -255 p4 p1)
	  )
	)
      )
    )
  )
)
(redraw)
(if (setq ss (ssget po (list p1 p2 p3 p4)))
  (repeat (setq n (sslength ss))
    (setq ent (ssname ss (setq n (1- n))))
    (if	(not (ssmemb ent sst))
      (ssadd ent sst)
    )
    (sssetfirst nil sst)
  )
)
     )
     (progn
(ssadd (ssname p1 0) sst)
(sssetfirst nil sst)
     )
   )
 )
 (sssetfirst nil sst)
 (setq	*error*	m:err
m:err nil
 )
 (princ)
) 

 

Récapitulatif des commandes :

 

SSOF : l'objet sélectionné (polyligne, cercle ou ellipse) sert de fenêtre de sélection

SSOC : l'objet sélectionné (polyligne, cercle ou ellipse) sert de capture de sélection

SSL : sélection de tous les objets de même calque que l'objet sélectionné.

SSE : sélection de tous les objets de même type que l'objet sélectionné.

SSC : sélection de tous les objets de même couleur que l'objet sélectionné.

SSTL : sélection de tous les objets de même type de ligne que l'objet sélectionné.

SSCU :fenêtre de sélection parallèle au SCU courant.

[pfj]

Bonjour Gile, très intéressé par vos routines de sélection, je tente d'en utiliser certaines sous AutoCad 2008 mais je rencontre quelques difficultés. Notamment, la commande SSOF : une fois la polyligne encadrante sélectionnée, les objets inclus ne sont pas tous sélectionnés.

N'étant pas un spécialiste Lisp, je dois faire une erreur de manipulation quelque part mais je ne trouve pas où......

Merci d'avance pour votre aide.

 

Pfj

[(gile)]

Salut et bienvenue,

 

Difficile de répondre comme ça, à priori on ne peut pas faire de mauvaises manipulations avec ssof.

 

Les objets qui ne sont pas sélectionnés sont ils :

- strictement à l'intérieur de la polyligne ?

- sur des calques déverrouillés ?

 

PS : un plus grand choix de routines (et les dernières versions) sur cette page.

 

[Edité le 11/11/2007 par (gile)]

[pfj]

Merci pour cette réponse très rapide.

Suite à de nouveaux essais, les objets non sélectionnés par SSOF sont sur des calques libres mais ils ne sont pas strictement à l'intérieur de la polyligne (un ou plusieurs points de contact).

Votre routine est-elle modifiable pour résoudre ce genre de problème ???

 

Bien cordialement.

 

Pfj

[(gile)]

SSOF fonctionne avec une sélection par fenêtre polygonale, donc comme avec ce mode de sélection, seuls les objets strictement à l'intérieur de la fenêtre sont sélectionnés.

 

Peut-être SSOC, qui fonctionne avec un mode de sélection par capture, conviendrait mieux.

[pfj]

Merci beaucoup pour votre réactivité et vos conseils.

 

A bientôt. Bien cordialement.

 

Pfj

[PHILPHIL]

salut gile

 

si je comprend bien tes lisp "SSOF" et "SSOC"

 

ils marchent comme selection avec options

 

SSOF = select + sp

SSOC = select + cp

 

quand sur un tres grand plan je veux etirer des objets assez petit je fais

"etirer" + cp avec des zoom à la molette ( avant arriere )

par contre ca a tendance a force a perdre quelque points de capture et ne plus tous selectionner les grips des objets a etirer

 

est ce qu'il est possible de faire un mixte entre la focntion "etirer" et tes lisp "SSOC" "SSOF"

 

1 créer une polyligne fermée hors lisp incluant les objets que l'on veux etirer

lancer le lisp

2 lancer la fonction "etirer"

3 sélectionner la polyligne créer precedement qui selectionne les grips des objets a l'interieur de la polyligne ( qui correspondrait a "CP" sans avoir besoin de zoomer )

4 donner la distance direction d'etirement

5 supression de la polyligne de selection

 

possible ca ???

 

bonne journée

 

phil

 

[(gile)]

Salut,

 

SSOC et SSOF utilisent la routine SelByObj qui sélectionne les objets.

La commande étirer utilise un mode de sélection spécial sui ne sélectionne que certains sommets des objets.

Mais on peut facilement faire ce que tu demandes, on récupère les coordonnées (SCU) des sommets de la polyligne et on les passe comme arguments à la commande etirer.

 

EDIT : j'ai supprimé le :

(while (/= 0 (getvar "CMDACTIVE"))

(vl-cmdf pause)

)

inutile

 

(defun c:etcp (/ ent elst plst)
 (and
   (setq ent (car (entsel)))
   (setq elst (entget ent))
   (= "LWPOLYLINE" (cdr (assoc 0 elst)))
   (setq plst (mapcar
	 (function
	   (lambda (x)
	     (trans (cdr x) ent 1)
	   )
	 )
	 (vl-remove-if-not
	   (function
	     (lambda (x)
	       (= (car x) 10)
	     )
	   )
	   elst
	 )
       )
   )
   (vl-cmdf "_.erase"  ent "")
   (vl-cmdf "_.stretch" "_cp")
   (mapcar 'vl-cmdf plst)
   (vl-cmdf "" "")
 )
 (princ)
) 

 

[Edité le 19/11/2007 par (gile)]

[PHILPHIL]

salut gile

 

comme d'habbb

ca marche d'enfer

 

merci

 

phil