Detection de Polylignes 2D croisees/touchees (Papillons)

[lecrabe]

Hello

 

Je cherche une routine (que je croyais avoir deja vu ici) mais je ne trouve pas !

 

*** Principe ***

 

1) Selection classique AutoCAD ...

 

2) On ne retient que les Polylignes 2D (Closes ou Non)

 

3) On force la couleur en BLEU (par exemple) des polylignes

ayant au moins UN croisement (ou papillon) sur leur parcours

(Ou a la rigueur, on cree une simple selection pour forcer la couleur apres manuellement)

 

Attention pour moi, un croisement (ou papillon) c'est :

- soit un VRAI croisement

- soit une simple "touchette" polyligne qui revient se toucher par "Proche" sur elle-meme

et qui repart peut etre ailleurs ...

 

Le top du top, ce serait forcer en BLEU si il y a UN SEUL croisement ou touchette

et forcer en ROUGE si il y a N croisements ou touchettes ...

 

A votre bon coeur, Merci d'avance, lecrabe

[lecrabe]

Hello les vaillants Lispeurs/VLispeurs

 

SVP je reveille un peu le sujet en proposant plutot

de dessiner des simples points graphiques AutoCAD (sur le calque courant)

partout ou une Polyligne se croise ou se touche "elle meme" !

x les Polylignes 2D selectionnees ...

 

Merci d'avance, lecrabe

[Patrick_35]

Salut

 

Quelque chose comme ça ?

 

(defun c:pap(/ doc com ent lst sel)
 (setq doc (vla-get-activedocument (vlax-get-acad-object)))
 (vla-startundomark doc)
 (and (ssget (list (cons 0 "LWPOLYLINE")))
   (progn
     (vlax-for ent (setq sel (vla-get-activeselectionset doc))
(vlax-for com sel
  (and (/= ent com)
       (setq lst (vlax-invoke ent 'intersectwith com acextendnone))
    (progn
      (if (> (length lst) 3)
	(mapcar '(lambda(x)(vlax-put x 'color 5)) (list ent com))
	(mapcar '(lambda(x)(vlax-put x 'color 1)) (list ent com))
      )
    )
  )
)
     )
     (vla-delete sel)
   )
 )
 (vla-endundomark doc)
 (princ)
)

 

@+

[lecrabe]

Hello Patrick

 

1) Merci

 

Je teste sur AutoCAD 2013, j'ose esperer que cela n'est pas la source de mes problemes !?

Je vais retester sur AutoCAD 2010 apres ... voire meme 2009 ...

Comme tu le sais, je suis un "redoutable" testeur !!

 

2) Malheureusement cela ne fonctionne pas du tout comme prevu

Par exemple :

 

- Une polyligne close (polyligne non croisante, non touchante)

est forcee en BLEU : un simple rectangle par exemple - INCORRECT

- Idem pour le meme rectangle ouvert donc en forme de U

(polyligne non croisante, non touchante) : force en BLEU - INCORRECT

 

- Une polyligne de 2 segments (polyligne non croisante, non touchante)

est forcee en ROUGE - INCORRECT

 

- Une polyligne en 4 points qui forme en fait un triangle est forcee en BLEU = CORRECT

Car en fait au 4eme point on est revenu accrocher le 1er point (Horreur) : on aurait du faire un CLORE au 3eme point !

Donc pour moi, c une TOUCHETTE ! = BRAVO !!

 

- Une polyligne avec de multiples points sur elle meme (on a clique plusieurs fois sur le meme point : maladie de la tremblote) est forcee en BLEU : BOF je pense que ROUGE serait sans doute mieux !, A voir ...

 

- Polyligne croisante SIMPLE en 4 segments, forcee en BLEU = BRAVO !!

Polyligne en forme de lettre grecque alpha

- La meme polyligne (1 segment supplementaire) avec 1 autre croisement, toujours forcee en BLEU = INCORRECT

 

Je continue mes tests ...

 

Encore Merci, lecrabe

[lecrabe]

Hello

 

J'ai teste sous AutoCAD 2013 et sous AutoCAD 2009 = meme resultat

 

lecrabe

[Patrick_35]

Je comprends pas.

J'avais testé et cela semblait fonctionner

Tu as un fichier test pour que je modifie

 

@+

[lecrabe]

Hello

 

SVP tu m'envoies un courriel sur cadxp at hotmail point fr

 

Ou bien si tu as ma MP, tu envoies "direct" que je puisse te repondre ...

 

Merci, Bonne soiree, lecrabe

[lecrabe]

Hello

 

Youpee et Grand Merci a Patrick_35 qui a travaille comme un Dieu !

 

Suite a nos echanges d'Emails voici donc le resultat qui est OK

par rapport a mon DWG de Test et ma demande ...

 

lecrabe

 

;;
;; Routine (PAP --> PAPILLON) de Detection de Croisement/Papillon ou Touchette Polyligne par Polyligne
;; Routine PAPILLON vs 1.02 par P35 suite a la demande de lecrabe
;; Attention: Cette routine ne teste pas le Croisement des Polylignes entre elles
;; Couleur = 1 Rouge : N croisements/ Papillons ou Touchettes
;; Couleur = 5 Bleu  : 1 croisement / Papillon  ou Touchette 
;;

(vl-load-com)

(defun c:papillon (/ doc cnt ent ele nb new lst pt1 pt2 pts sel tbl tot croise)
(defun croise(pts lst clo / cnt pt1 pt2 tot)
(setq cnt 0 tot 0)
(while (setq pt1 (nth cnt lst))
(if (and (eq cnt (length lst))
(eq clo :vlax-true)
)
(setq pt2 (nth 0 lst))
(setq pt2 (nth (1+ cnt) lst))
)
(and (/= (car pts) pt1)
(/= (cadr pts) pt1)
pt2
(/= (car pts) pt2)
(/= (cadr pts) pt2)
(inters (car pts) (cadr pts) pt1 pt2)
(setq tot (1+ tot))
)
(setq cnt (1+ cnt))
)
tot
)

(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(vla-startundomark doc)
(and (ssget (list (cons 0 "LWPOLYLINE")))
(progn
(vlax-for ent (setq sel (vla-get-activeselectionset doc))
(setq lst nil new nil cnt 0 tot 0)
(while (not (vl-catch-all-error-p (setq pts (vl-catch-all-apply
'vla-get-coordinate (list ent cnt)))))
(setq lst (cons (vlax-safearray->list (vlax-variant-value pts)) lst)
cnt (1+ cnt)
)
)
(setq cnt 0)
(while (setq pt1 (nth cnt lst))
(if (and (eq cnt (length lst))
(eq (vla-get-closed ent) :vlax-true)
)
(setq pt2 (nth 0 lst))
(setq pt2 (nth (1+ cnt) lst))
)
(and pt2 (setq tot (+ tot (croise (list pt1 pt2) lst (vla-get-closed ent)))))
(setq cnt (1+ cnt))
)
(if (equal (car lst) (last lst))
(setq tot (- tot 2))
)
(while lst
(setq nb (length lst)
ele (car lst)
lst (vl-remove ele lst)
cnt (- nb (length lst))
)
(and (> cnt 1)
(setq tot (+ tot cnt))
)
)
(cond
((= tot 2)

;;; Couleur BLEU  = 5
(vlax-put ent 'color 5)

)
((> tot 2)

;;; Couleur ROUGE = 1
(vlax-put ent 'color 1)

)
)
)
(vla-delete sel)
)
)
(vla-endundomark doc)
(princ)
)
 

[-Olivier-]

Bonjour,

 

Etant débutant en lisp, je me suis intéressé à cette routine sans aller jusqu'au bout donc j'admire le maître. B)

J'ai juste remarqué que la routine ci-dessus ne fonctionne pas correctement si la polyligne comprend 1 ou plusieurs segments avec arcs.

C'est seulement une remarque car n'ayant pas d'utilisation pour cette routine, je n'ai pas besoin qu'elle soit modifiée.

 

A voir avec Lecrabe si il risque de rencontrer le cas.

 

A+ ;)

[lecrabe]

Hello

 

Pour mes besoins, la notion d'Arc n'est pas vitale

 

Mais bon, cela peut etre necessaire pour d'autres utilisateurs !?

 

L'etape ulterieure, c de detecter (et donc marquer) les Polylignes qui se croisent entre elles ...

 

lecrabe

[Patrick_35]

Salut

 

Etant débutant en lisp, je me suis intéressé à cette routine sans aller jusqu'au bout donc j'admire le maître. B)

Je sens que mes chevilles vont gonfler :(rires forts):

 

J'ai juste remarqué que la routine ci-dessus ne fonctionne pas correctement si la polyligne comprend 1 ou plusieurs segments avec arcs.

Ben si, elle fonctionne avec des arc :huh:

 

Hello

 

Pour mes besoins, la notion d'Arc n'est pas vitale

 

Mais bon, cela peut etre necessaire pour d'autres utilisateurs !?

 

L'etape ulterieure, c de detecter (et donc marquer) les Polylignes qui se croisent entre elles ...

 

lecrabe

Ben voila.

 

;;
;; Routine (PAP --> PAPILLON) de Detection de Croisement/Papillon ou Touchette Polyligne par Polyligne
;; Routine PAPILLON vs 1.03 par P35 suite a la demande de lecrabe
;; Couleur 1 --> Plusieurs pap ou touchettes sans croisement avec d'autres poly
;; Couleur 2 --> Plusieurs pap ou touchettes avec 1 croisement avec d'autres poly
;; Couleur 3 --> Plusieurs pap ou touchettes avec plusieurs croisements avec d'autres poly
;; Couleur 4 --> Aucun pap ou touchette avec plusieurs croisements avec d'autres poly
;; Couleur 5 --> Un pap ou touchette sans croisement avec d'autres poly
;; Couleur 6 --> Un pap ou touchette avec 1 croisement avec d'autres poly
;; Couleur 7 --> Un pap ou touchette avec plusieurs croisements avec d'autres poly
;; Couleur 8 --> Aucun pap ou touchette avec 1 croisement avec d'autres poly
;;

(defun c:papillon(/ col com doc ent sel tot croise un_seg)
 (defun croise(pts lst clo / cnt pt1 pt2 tot)
   (setq cnt 0 tot 0)
   (while (setq pt1 (nth cnt lst))
     (if (and	(eq cnt (length lst))
	(eq clo :vlax-true)
  )
(setq pt2 (nth 0 lst))
(setq pt2 (nth (1+ cnt) lst))
     )
     (and (/= (car pts)  pt1)
   (/= (cadr pts) pt1)
   pt2
   (/= (car pts)  pt2)
   (/= (cadr pts) pt2)
   (inters (car pts) (cadr pts) pt1 pt2)
(setq tot (1+ tot))
     )
     (setq cnt (1+ cnt))
   )
   tot
 )

 (defun un_seg(ent / cnt ele lst nb pt1 pt2 tot)
   (setq lst nil cnt 0 tot 0)
   (while (not (vl-catch-all-error-p (setq pts (vl-catch-all-apply 'vla-get-coordinate (list ent cnt)))))
     (setq lst (cons (vlax-safearray->list (vlax-variant-value pts)) lst)
    cnt (1+ cnt)
     )
   )
   (setq cnt 0)
   (while (setq pt1 (nth cnt lst))
     (if (and (eq cnt (length lst))
       (eq (vla-get-closed ent) :vlax-true)
  )
(setq pt2 (nth 0 lst))
(setq pt2 (nth (1+ cnt) lst))
     )
     (and pt2 (setq tot (+ tot (croise (list pt1 pt2) lst (vla-get-closed ent)))))
     (setq cnt (1+ cnt))
   )
   (if (equal (car lst) (last lst))
     (setq tot (- tot 2))
   )
   (while lst
     (setq nb  (length lst)
    ele (car lst)
    lst (vl-remove ele lst)
    cnt (- nb (length lst))
     )
     (and (> cnt 1)
(setq tot (+ tot cnt))
     )
   )
   tot
 )

 (vl-load-com)
 (setq doc (vla-get-activedocument (vlax-get-acad-object)))
 (vla-startundomark doc)
 (and (ssget (list (cons 0 "LWPOLYLINE")))
   (progn
     (vlax-for ent (setq sel (vla-get-activeselectionset doc))
(setq tot (un_seg ent)
      col nil
)
(vlax-for com sel
  (and (not (equal ent com))
       (setq lst (vlax-invoke ent 'intersectwith com acextendnone))
    (progn
      (if (> (length lst) 3)
	(setq col 2)
	(or col (setq col 1))
      )
    )
  )
)
(cond
  ((and (> tot 2) (not col))
    (vlax-put ent 'color 1)
  )
  ((and (> tot 2) (= col 1))
    (vlax-put ent 'color 2)
  )
  ((and (> tot 2) (= col 2))
    (vlax-put ent 'color 3)
  )
  ((and (= tot 0) (= col 2))
    (vlax-put ent 'color 4)
  )
  ((and (= tot 2) (not col))
    (vlax-put ent 'color 5)
  )
  ((and (= tot 2) (= col 1))
    (vlax-put ent 'color 6)
  )
  ((and (= tot 2) (= col 2))
    (vlax-put ent 'color 7)
  )
  ((and (= tot 0) (= col 1))
    (vlax-put ent 'color 8)
  )
)
     )
     (vla-delete sel)
   )
 )
 (vla-endundomark doc)
 (princ)
)

 

@+

[-Olivier-]

Bonjour,

 

Ben si, elle fonctionne avec des arc

 

Je ne dis pas quel ne fonctionne pas avec des arcs. En revanche dans mes tests ils étaient considérés comme des segments droits. Les croisements ne correspondent donc pas.

exemples :

- 2 arcs formant une boucle, l'intersection n'est pas détectée.

- Si un ou segment revient à l'intérieur d'un arc sans le toucher alors une intersection est détectée alors qu'il n'y en a pas.

 

Encore une fois il est inutile de modifier la routine pour moi. J'ai juste repéré le problème car cela faisais partie de mes points de bloquage lorsque j'ai tenté de créer la routine et je me demandais comment tu avais résolu le problème.

C'est juste un constat pour les éventuels utilisateurs.

 

Comme tu le sais, je suis un "redoutable" testeur !!

 

Apparemment, Lecrabe, je suis encore pire ! :(rires forts):

 

A+

[lecrabe]

Hello

 

Il est sur que je n'ai fais aucun test avec des arcs

 

Etre Pire que l'affreux "crabe decapodesque", a priori cela va etre difficile !

 

Mais bon, tout est possible ...

 

lecrabe "sans arc"

[(gile)]

Salut,

 

J'ai trouvé une méthode pour les "auto-intersections" avec .NET que je trouvais intéressante : décomposer la polyligne et chercher les intersections entre les entités (lignes et arcs) résultant de la décomposition. Il suffit juste de supprimer les points entre segments contigus et les éventuels doublons.

Ça doit être facilement adaptable en Visual LISP.

 

J'ai fait deux versions : pour 2010-2012 et pour 2013-?, nom de la commande : PAPILLON

 

SelfIntersectPolyline.zip

 

Le code n'est pas beaucoup plus long que le code LISP

 

using System;
using System.Linq;
using Autodesk.AutoCAD.ApplicationServices;
using Autodesk.AutoCAD.Colors;
using Autodesk.AutoCAD.DatabaseServices;
using Autodesk.AutoCAD.EditorInput;
using Autodesk.AutoCAD.Geometry;
using Autodesk.AutoCAD.Runtime;

namespace SelfIntersectPolylines
{
   public class Commands
   {
       [CommandMethod("papillon")]
       public static void SelfIntersectPline()
       {
           Database db = HostApplicationServices.WorkingDatabase;
           Editor ed = Application.DocumentManager.MdiActiveDocument.Editor;
           TypedValue[] filter = { new TypedValue(0, "LWPOLYLINE") };
           PromptSelectionResult psr = ed.GetSelection(new SelectionFilter(filter));
           if (psr.Status != PromptStatus.OK)
               return;
           using (Transaction tr = db.TransactionManager.StartTransaction())
           {
               foreach (ObjectId id in psr.Value.GetObjectIds())
               {
                   Polyline pline = (Polyline)id.GetObject(OpenMode.ForRead);
                   int cnt = GetSelfIntersPoints(pline).Length;
                   if (pline.Closed) cnt--;
                   if (cnt < 1) continue;
                   pline.UpgradeOpen();
                   pline.Color = Color.FromColorIndex(ColorMethod.ByAci, (short)(cnt == 1 ? 5 : 1));
               }
               tr.Commit();
           }
       }

       private static Point3d[] GetSelfIntersPoints(Polyline polyline)
       {
           DBObjectCollection entities = new DBObjectCollection();
           polyline.Explode(entities);
           Point3dCollection points = new Point3dCollection();
           for (int i = 0; i < entities.Count; ++i)
           {
               for (int j = i + 1; j < entities.Count; ++j)
               {
                   Curve curve1 = entities[i] as Curve;
                   Curve curve2 = entities[j] as Curve;
#if ACAD_19
                   curve1.IntersectWith(curve2, Intersect.OnBothOperands, points, IntPtr.Zero, IntPtr.Zero);
#else
                   curve1.IntersectWith(curve2, Intersect.OnBothOperands, points, 0, 0);
#endif
                   foreach (Point3d point in points)
                       if (point == curve1.StartPoint || point == curve1.EndPoint &&
                           point == curve2.StartPoint || point == curve2.EndPoint &&
                           j == i + 1)
                           points.Remove(point);
               }
               entities[i].Dispose();
           }
           return points.Cast<Point3d>().Distinct().ToArray();
       }
   }
}

[lecrabe]

Hello Patrick et Gilles

 

Merci, Merci mais je n'ai pas encore teste vos nouvelles routines

pour la detection de polylignes auto croisantes ou auto touchantes entre elles !?

 

Pour moi des polylignes 2D differentes (closes ou non, avec ou sans arcs) qui se touchent par UN ou N points communs et/ou par UN ou N segments/arcs communs sont bien entendu a marquer par une couleur specifique !

 

La detection des arcs communs ou de touchettes sur les arcs, ce serait le TOP !

 

Pour Gilles, si j'ai bien compris ta routine DLL traite en principe correctement les arcs ?

 

J'espere tester ce WE ou sinon la semaine prochaine ...

 

lecrabe

[(gile)]

La routine ne traite que les "auto-intersections" et prend en compte les arcs.

Il est peut être intéressant de transposer la méthode en LISP qui est plus souple d'utilisation.

[(gile)]

Un LISP qui utilise le même algorithme que le code C# ci-dessus

 

(defun 3dCoordsToPoints	(lst)
 (if lst
   (cons (list (car lst) (cadr lst) (caddr lst))
  (3dCoordsToPoints (cdddr lst))
   )
 )
)

(defun remove_doubles (lst)
 (if lst
   (cons (car lst) (remove_doubles (vl-remove (car lst) lst)))
 )
)

(defun SelfInstersPoints (pline / subents subent1 tmp intersPts)
 (setq subents (vlax-invoke pline 'Explode))
 (while subents
   (setq subent1 (car subents)
  subents (cdr subents)
   )
   (foreach subent subents
     (setq tmp (3dCoordsToPoints (vlax-invoke subent1 'IntersectWith subent acExtendNone)))
     (foreach pt tmp
(if (and
      (equal subent (car subents))
      (or (equal pt (vlax-curve-getStartPoint subent1) 1e-9)
	  (equal pt (vlax-curve-getEndPoint subent1) 1e-9)
      )
      (or (equal pt (vlax-curve-getStartPoint subent) 1e-9)
	  (equal pt (vlax-curve-getEndPoint subent) 1e-9)
      )
    )
  (setq tmp (vl-remove pt tmp))
)
     )
     (setq intersPts (append tmp intersPts))
   )
   (vla-delete subent1)
 )
 (remove_doubles intersPts)
)

(defun c:pap (/ *error* ss pts)
 (vl-load-com)
 (or *acdoc* (setq *acdoc* (vla-get-ActiveDocument (vlax-get-acad-object))))
 (defun *error* (msg)
   (and
     msg
     (/= msg "Fonction annulée")
     (princ (strcat "\nErreur: " msg))
   )
   (vla-EndUndomark *acdoc*)
   (princ)
 )
 (vla-StartUndomark *acdoc*)
 (if (ssget '((0 . "LWPOLYLINE")))
   (progn
     (vlax-for	pl (setq ss (vla-get-ActiveSelectionSet *acdoc*))
(setq cnt (length (SelfInstersPoints pl)))
(and (= (vla-get-Closed pl) :vlax-true) (setq cnt (1- cnt)))
(if (< 0 cnt)
  (if (= 1 cnt)
    (vla-put-Color pl 5)
    (vla-put-Color pl 1)
  )
)
     )
     (vla-Delete ss)
   )
 )
 (*error* nil)
)

[lecrabe]

Hello Gilles

 

Merci pour la version VLisp

 

Sur un 1er test rapide, la routine semble OK !

 

et marque meme les polylignes avec des rebroussements (P1, P2, P3, Retour a P2, P3, P4, etc)

ce qui me parait normal car c'est une sorte de croisement

 

par contre elle ne voit pas une polyligne de type : P1, P2, P3, P3

ce qui me parait normal, car il n'y a aucun croisement

c simplement des points multiples !

Mais dans ce cas ton excellente routine PPL sera lancee AVANT !

 

Je vais essayer de faire la semaine prochaine des tests plus poussees ...

 

Sinon la version DOTNET tournerait en theorie combien de fois plus vite ?

Je ne suis pas persuade que la difference soit enorme : x2 peut etre !?

 

Merci, lecrabe "testeur"

[(gile)]

J'ai modifié le LISP ci-dessus (ajouté une tolérance dans la comparaison des points).

[lecrabe]

Hello Gilles

 

MERCI pour la micro-modif suite a ma remarque ...

 

SI j'ai bien compris et que je parametre 1e-2 et non pas 1e-9 (TA micro-modif)

la routine va detecter les polylignes "approchantes" a une distance de 1e-2 ?

 

lecrabe

[bazoul]

Messieurs,

Ya de ça quelque temps je m'étais amusé a refaire la fonction d'intersection de polyligne autocad et concernant la demande si dessous c'est le temps de traitement qui peche .... pour deux polylignes closes identiques composées de 11.000 arcs qui s'intersectent mon algo mettait 11minute là ou la fonction intersectwith d'autocad en mettait un peu plus de 33minutes ....

Concernant une polyligne composée de 1.000arcs l'algo était 62fois plus rapide ...

Les temps annoncés tenant compte du temps de conversion des objets autocad en objet ... le tout fait en VB.net.

 

Mon but était de trouver tous les points d'intersections réel entre deux polylignes sélectionnés..

Au final dans mon exercice tous se résumait en calcul mathématique... en revanche j'ai laché le morceau quand j'ai voulu m'attaquer au arcs elliptique ^^

 

 

L'etape ulterieure, c de detecter (et donc marquer) les Polylignes qui se croisent entre elles ...

 

lecrabe

[joris25]

Bonjour à tous en utilisant le lisp papillon je me rends compte que lorsque deux polylignes se longent (donc des segments parfaitement superposés) papillon annonce ces polylignes en cyan de la meme maniere que les polylignes qui se croisent vraiment (une partie de polyligne à l'intérieur d'une autre), y a t'il moyen de resoudre ce probleme et que papillon distingue vraiment intersection et superposition??

 

Merci d'avance à tous ...