Théorème de Jordan

[zebulon_]

Bonjour,

 

Il y a de cela quelques années, nous avons parlé de ce sujet

 

Afin de rendre à César ce qui est à César et à Jordan ce qui est à Jordan, je vous invite à consulter le théorème de Jordan

 

Il est célèbre par le caractère apparemment intuitif de son énoncé et la difficulté de sa démonstration

 

Une proposition de code dont l'objectif est de savoir où est un point par rapport à une polyligne plane fermée. Le principe est simple : on trace une demi-droite à partir du point étudié et on compte le nombre d'intersections avec la polyligne. Si ce nombre est pair, on est à l'extérieur, sinon à l'intérieur. La difficulté est qu'il faut s'assurer que la demi-droite ne passe ni par un sommet de la polyligne, ni par un point de tangence s'il y a des segments courbes.

 

(defun getpolySegs (ent / PTL I PTB SEG LSEG)
 ;; Afralisp
 ;; renvoie les segments d'une polyligne
 ;; sous la forme d'une liste
 ;; '(((x1 y1) bulge1 (x2 y2)) ... ((xn-1 yn-1) bulgen (xn yn)))
 (if (= (type ent) 'ENAME)
   (setq ent (vlax-ename->vla-object ent))
 )
 ;; collecter la liste des point sous la forme (x1 y1 x2 y2 ... xn yn)
 (setq PTL (vlax-safearray->list (vlax-variant-value (vla-get-Coordinates ENT))))
 ;; collecter la liste des bulges
 (setq I 0) 
 (repeat (/ (length PTL) 2)
   (setq PTB (cons (vla-GetBulge ent I) PTB))
   (setq I (1+ I))
 )
 (setq PTB (reverse PTB))
 ;; polyligne fermée -> rajouter le premier point à la liste de points
 (if (= (vla-get-closed ent) :vlax-true)
   (setq PTL (append PTL (list (car PTL) (cadr PTL))))
 )
 ;; transformer en liste de segments
 (setq I 0)
 (repeat (- (/ (length PTL) 2) 1)
   (setq SEG
     (list
       (list (nth I PTL) (nth (+ I 1) PTL))
       (nth (/ I 2) PTB)
       (list (nth (+ I 2) PTL) (nth (+ I 3) PTL))
     )
   )
   (setq LSEG (cons SEG LSEG))
   (setq I (+ I 2))
 )
 (reverse LSEG)
)

(defun getArcInfo (segment / a p1 bulge p2 c p3 p4 p r s result)
 ;; Afralisp
 ;; renvoie les informations d"un segment courbe
 ;; sous la forme d'une liste '((xc yc) R)
 ;;
 ;; assigner variables avec les valeurs de l'argument
 (mapcar 'set '(p1 bulge p2) segment)
 (if (not (zerop bulge))
   (progn
     ;; trouver la corde
     (setq c (distance p1 p2))
     ;; trouver la flèche
     (setq s (* (/ c 2.0) (abs bulge)))
     ;; trouver le rayon par Pythagore
     (setq r (/ (+ (expt s 2.0) (expt (/ c 2.0) 2.0)) (* 2.0 s)))
     ;; distance au centre
     (setq a (- r s))
     ;; coordonnées du milieu de p1 et P2
     (setq P4 (polar P1 (angle P1 P2) (/ c 2.0)))
     ;; coordonnées du centre
     (setq p
       (if (>= bulge 0)
         (polar p4 (+ (angle p1 p2) (/ pi 2.0)) a)
         (polar p4 (- (angle p1 p2) (/ pi 2.0)) a)
       )  
     )
     ;; coordonnées de P3
     (setq p3
       (if (>= bulge 0)
         (polar p4 (- (angle p1 p2) (/ pi 2.0)) s)
         (polar p4 (+ (angle p1 p2) (/ pi 2.0)) s)
       )  
     )
     (setq result (list p r))
   )
   (setq result nil)
 )
 result
)

(defun randnum (/ modulus multiplier increment random)
 ;; afralisp
 ;; renvoie un nombre pseudo aléatoire entre 0 et 1
 ;;
 (if (not seed)
   (setq seed (getvar "DATE"))
 )
 (setq modulus    65536
       multiplier 25173
       increment  13849
       seed  (rem (+ (* multiplier seed) increment) modulus)
       random     (/ seed modulus)
 )
)

(defun inout (pt ent / AcDoc Space RES LSEG LANGLE ArcInf D D1 ANG pttan1 pttan2 RAY NBPTS)
 ;; revoie 0 -> pt est sur ent
 ;; +1 -> pt à l'intérieur de ent
 ;; -1 -> pt à l'extérieur de ent
 ;;
 (setq AcDoc (vla-get-activeDocument (vlax-get-acad-object))
       Space (if (= (getvar "CVPORT") 1)
               (vla-get-PaperSpace AcDoc)
               (vla-get-ModelSpace AcDoc) 
             )
 )
 (if (equal (distance pt (vlax-curve-GetClosestPointTo ent pt)) 0.0 1e-10) ;; pt est sur le contour
   (setq RES 0)
   (progn
     (setq LSEG (getpolysegs ent))

     (foreach X (mapcar 'car LSEG)  ;; je collectionne tous les angles que fait pt avec chaque sommet
       (setq LANGLE (cons (angle PT X) LANGLE))
     )

     (foreach X (vl-remove-if '(lambda (x) (zerop (cadr x))) LSEG) ;; on ne garde que les segments qui ont une courbure
       (setq ArcInf (getarcinfo X))
       (setq D (distance PT (car ArcInf)))
       (if (> D (cadr ArcInf))  ;; on ne cherche les tangentes que si le point est en dehors du cercle
         (progn
           (setq D1 (sqrt (- (expt D 2) (expt (cadr ArcInf) 2))))
           (setq ANG (atan (/ (cadr ArcInf) D1)))
           (setq pttan1 (polar pt (+ (angle pt (car ArcInf)) ANG) D1))
           (setq pttan2 (polar pt (- (angle pt (car ArcInf)) ANG) D1))
           (setq LANGLE (cons (angle PT pttan1) LANGLE)) ;; je collecte les points de tangence que je garde
           (setq LANGLE (cons (angle PT pttan2) LANGLE)) ;; même s'ils ne sont pas forcément sur le contour de ent.
         )
       )
     ) ;; foreach

     ;; on cherche un angle pour tracer la demi-droite différent de ceux collectés ci-dessus
     ;; pour s'assurer que la demi-droite ne passera pas par un sommet ou un point de tangence
     (while
       (member (rtos (setq ANG (* (randnum) 2 pi)) 2 2) (mapcar '(lambda (x) (rtos x 2 2)) LANGLE))
     )
     (setq RAY (vla-addRay Space (vlax-3d-point pt) (vlax-3d-point (polar pt ang 1.00))))  ;; on trace une demi-droite
     (setq NBPTS (/ (length (vlax-invoke ent 'IntersectWith RAY acExtendNone)) 3))         ;; on regarde le nombre de point
     (vla-erase RAY)
     (cond
       ((= (rem NBPTS 2) 0) (setq RES -1))  ;; c'est pair donc c'est à l'extérieur
       (T (setq RES 1))                     ;; c'est impair donc à l'intérieur
     )
   )
 )
 RES
) ;; defun




(defun c:test (/ ent pt RES)
 (and
   (setq ent (car (entsel "\nSélectionnez une polyligne: ")))
   (setq ent (vlax-ename->vla-object ent))
   (= (vla-get-ObjectName ent) "AcDbPolyline")
   (= (vla-get-Closed ent) :vlax-true)
   (setq pt (trans (getpoint "\nSpécifiez un point: ") 1 0))
   (setq RES (inout pt ent))
   (cond
     ((zerop RES) (alert "Sur le contour"))
     ((minusp RES) (alert "Dehors"))
     (T (alert "Dedans"))
   )  
 )
 (princ)
) 

 

Amicalement

Vincent

[Curlygoth]

La meme chose existe en VBA (code) :

 

Function Point_dans_Polyligne(PolyLigne, Pt1) As Boolean
Dim Pt1(0 To 2) As Double
Dim Pt2(0 To 2) As Double
Dim Droite As AcadRay
Dim Points As Variant
Pt2(0) = Pt1(0) + 1
Pt2(1) = Pt1(1)
Pt2(2) = Pt1(2)
Set Droite = ThisDrawing.ModelSpace.AddRay(PT_TEST, Pt2)
Droite.Update
PointsINT = PolyLigne.IntersectWith(Droite, acExtendNone)
Droite.Delete
Dim NbrePoints As Integer
NbrePoints = UBound(PointsINT) / 3
Point_dans_Polyligne = False
If NbrePoints Mod 2 = 0 Then
   Point_dans_Polyligne = False
Else
   Point_dans_Polyligne = True
End If
End Function