Interférences 2D

[(gile)]

Suite à ce sujet et à une autre discussion ici, j'ai un peu creusé la question des interférences (collisions) entre les objets 2D.

 

Le LISP crée une région sur les interférences entre tous les objets 2D sélectionnés (cercles, ellipses, lwpolylignes, blocs).

 

Le LISP utilise la commande REGION et ne fonctionne donc pas sur les polygones croisés (lwpolylignes ou composants de blocs)

 

La région est de la couleur spécifiée (on peut aussi choisir DUCALQUE après avoir activé un calque).

 

Seuls les objets situés sur le plan XY du SCU courant (quelque soit celui-ci) peuvent être sélectionnés.

 

Taper INTERFERE_2D pour lancer la commande

 

Supprimer les espaces après les "

 

;;; INTERFERE_2D -Gilles Chanteau- 22/06/06
;;; Crée une région aux interférences des objets du jeu de sélection :
;;; blocs (si contour fermé), polylignes fermées, cercles, ellipses, splines.
;;; Fonctionne uniquement dans le plan du SCU courant
;;; Les objets d'interférences sont mis en "surbrillance".
;;; Lutilisateur choisit de les supprimer ou de les conserver, dans ce cas, il lui
;;; est proposé de les placer sur un calque spécifique et/ou de forcer leur couleur.

;;;*****************************************************************;;;

;; Re-définition de *error*

(defun inter_err (msg)
 (if (= msg "Fonction annulée")
   (princ)
   (princ (strcat "\nErreur : " msg))
 )
 (vla-EndUndoMark AcDoc)
 (setq	*error*	m:err
m:err nil
 )
 (princ)
)

;;;*****************************************************************;;;

;; Création de la région d'intersection entre deux objets

(defun inter_reg (lst)

 ;; Transforme la liste (objet1 objet2)
 ;; en liste de paires pointée ((lst_composants1 . region1) (lst_composants2 . region2))
 ;; lst_compsants ou nil si la décomposition est impossible (cercle, ellipse)
 ;; region ou "err" si la création de région est impossible

 (setq	lst (mapcar '(lambda (x / ent reg)
	       (if (vl-catch-all-error-p
		     (setq ent (vl-catch-all-apply ;_ liste des composants
				 'vlax-invoke
				 (list x 'explode)
			       )
		     )
		   )
		 (setq ent nil) ;_ pas de décomposition
	       )
	       (setq reg (vl-catch-all-apply ;_ liste des régions créées
			   'vlax-invoke
			   (list ModSp
				 'addRegion
				 (cond (ent)
				       (T (list x))
				 )
			   )
			 )
	       )
	       (if (vl-catch-all-error-p reg)
		 (cons ent "err") ;_ paire pointée si pas de région créée

		 ;; union des régions

		 (progn
		   (while (cadr reg)
		     (vla-boolean
		       (car reg)
		       acUnion
		       (cadr reg)
		     )
		     (setq reg (cons (car reg) (cddr reg)))
		   )
		   (cons ent (car reg)) ;_ paire pointée si une région créée
		 )
	       )
	     )
	    lst
    )
 )

 ;; suppression des composants des objets décomposés

 (mapcar 'vla-erase (apply 'append (mapcar 'car lst)))

 ;; intersection des deux régions et mise en surbrillance
 ;; ou suppression de l'unique région créée

 (cond
   ((and (/= (cdar lst) "err") (/= (cdadr lst) "err"))
    (vla-boolean (cdar lst) acIntersection (cdadr lst))
    (if (       (progn
 (vla-Highlight (cdar lst) :vlax-True)
 (setq int_lst (cons (cdar lst) int_lst))
      )
    )
   )
   ((/= (cdar lst) "err") (vla-delete (cdar lst)))
   ((/= (cdadr lst) "err") (vla-delete (cdadr lst)))
 )
)

;;;*****************************************************************;;;

;; Fonction principale

(defun c:interfere_2d (/ AcDoc ModSp ucszdir ss n lst int_lst col lay)
 (vl-load-com)
 (setq	AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
ModSp (vla-get-ModelSpace AcDoc)
 )
 (setq	m:err	*error*
*error*	inter_err
ucszdir	(trans '(0 0 1) 1 0 T)
 )
 (vla-StartUndoMark AcDoc)

 ;; Sélection des objets

 (prompt "\nSélectionnez les objets à traiter: ")
 (setq	ss (ssget
     (list '(-4 . "[color=#CC0000]		   '(-4 . "[color=#CC0000]		   '(0 . "LWPOLYLINE")
	   (cons 38 (caddr (trans '(0.0 0.0 0.0) 1 ucszdir)))
	   '(-4 . "and>")
	   '(-4 . "[color=#CC0000]		   '(0 . "CIRCLE,ELLIPSE,SPLINE,INSERT,")
	   '(-4 . "*,*,=")
	   (cons 10 (trans '(0.0 0.0 0.0) 1 ucszdir))
	   '(-4 . "and>")
	   '(-4 . "or>")
	   (cons 210 ucszdir)
     )
   )
 )

 ;; liste des objets sélectionnés

 (if ss
   (progn
     (repeat (setq n (sslength ss))
(setq
  lst
   (cons (vlax-ename->vla-object (ssname ss (setq n (1- n))))
	 lst
   )
)
     )

     ;; Boucle pour rechercher les intersections entre chacun des objets
     ;; et chaque objet placé après lui dans la liste

     (while (cadr lst)
(repeat	(- (setq n (length lst)) 1)
  (inter_reg (list (car lst) (nth (setq n (1- n)) lst)))
)
(setq lst (cdr lst))
     )
   )
 )

 (if int_lst
   (progn
     
     ;; Choix de la conservation des objets d'interférences

     (initget "Oui Non")
     (cond
((=
   "Non"
   (getkword
     (strcat
       "\n "
       (itoa (length int_lst))
       " interférence(s) on été trouvées."
       "\nConserver les objets d'interférences ? [Oui/Non] : "
     )
   )
 )

 ;; Suppression des objets

 (mapcar 'vla-delete int_lst)
)

;; choix du calque

(T
 (initget "Oui Non")
 (if
   (=
     "Oui"
     (getkword 
       "\nMettre les objets d'interférences sur un calque spécifique ? [Oui/Non] : "
     )
   )
    (progn
      (if (not *Interfere_layer*)
	(setq *Interfere_layer* "Interfere_2d")
      )
      (setq
	lay (getstring (strcat "\nEntrez le nom du calque 				       *Interfere_layer*
			       ">: "
		       )
	    )
      )
      (if (or (not lay) (= "" lay))
	(setq lay *Interfere_layer*)
	(setq *Interfere_layer* lay)
      )
      (vla-add (vla-get-Layers AcDoc) lay)
      (mapcar '(lambda (x)
		 (vla-put-Layer x lay)
	       )
	      int_lst
      )
    )
 )

 ;; Choix de la couleur

 (initget "Oui Non")
 (if
   (=
     "Oui"
     (getkword
       "\nForcer la couleur des objets d'interférences ? [Oui/Non] : "
     )
   )
    (progn
      (prompt "\nSélectionnez la couleur pour les interférences."
      )
      (while (not
	       (setq
		 col (acad_colordlg
		       (cond ((= (getvar "CECOLOR") "BYLAYER") 256)
			     ((= (getvar "CECOLOR") "BYBLOCK") 0)
			     (T (getvar "CECOLOR"))
		       )
		     )
	       )
	     )
      )
      (mapcar '(lambda (x)
		 (vla-put-Color x col)
	       )
	      int_lst
      )
    )
 )
 (mapcar '(lambda (x)
	    (vla-HighLight x :vlax-false)
	  )
	 int_lst
 )
)
     )
   )
   (princ "\nAucune interférence n'a été trouvée.")
 )

 (vla-EndUndoMark AcDoc)
 (setq	*error*	m:err
m:err nil
 )
 (princ)
)

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

 

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

[bonuscad]

Salut Gilles,

 

Un oublli de paranthèse s'est glissé dans ton code.

 

(repeat (- (setq n (length lst) 1)

 

devrait être

 

(repeat (- (setq n (length lst)) 1)

 

Sur des blocs je n'ai pas eu de résultats, mais ça ne "plante pas" ;)

 

Tester rapidement sur des "figures bateaux" et ça a fonctionné. :)

[(gile)]

Merci pour le retour, et bravo pour la perspicacité ;)

 

Je me demande bien comment un tel oubli a bien pu se glisser :casstet:

Je corrige.

 

Sur des blocs je n'ai pas eu de résultats, mais ça ne "plante pas"

 

En l'état, çà ne peut marcher que sur le contour fermé des blocs si celui-ci est composé d'entités jointves à leurs extrémités (c'est le fonctionnement de REGION).

 

Je vais essayer de refaire une boucle sur les entités composant les blocs et polys "couper" celles qui auraient des intersections.

 

exemple, la région unie créée est à doite:

 

http://img209.imageshack.us/img209/1479/region3om.png

[(gile)]

Je rajoute au filtre de sélection les splines, que j'avais oublié. Comme pour le polylignes elle ne doivent pas être "croisées" (seules les splines 2d du plan su SCU courant sont sélectionnées).

[(gile)]

J'ai remanié la routine pour qu'elle laisse plus de choix à l'utilisateur : dans un premier temps, les "objets d'interférence" sont juste mis en surbrillance (si aucune interérence n'a été trouvée, un message est délivré).

Il est demandé à l'utilisateur s'il veut conserver ces objets et si oui, il lui est proposé de les mettre sur un calque de son choix et/ou de forcer leur couleur.