Intersection droite/cercle droite/droite

zebulon_ · le 30 mars 2009

Bonjour,

Intersection droite/droite, on sait faire avec la fonction inters

le but du jeu est de trouver, s'il(s) existe(nt), les intersections entre une droite et un cercle, et entre 2 cercles. Les droites sont définies par 2 points et les cercles sont définis par leur centre et leur rayon et sont sur le même plan.

Une première méthode consiste à tracer les droites et les cercles, puis d'utiliser la méthode

(vlax-invoke OBJ1 'IntersectWith OBJ2 acExtendBoth)

puis d'effacer les objets créés.

Mais je voulais trouver les solutions sans dessiner puis effacer et avoir 2 fonctions

(intersDC PT1 PT2 PTC R) ;; intersection droite cercle

(intersCC PT1 R1 PT2 R2) ;; intersection cercle cercle

Voilà ce que cela peut donner

(defun intersDC1 (PT1 PT2 PT3 R / RES P1 P2 x1 x2 y1 y2 a b AF BF CF D xa ya xb yb)
 ;; intersection droite cercle de façon analytique
 ;; origine sur le centre du cercle, cela simplifie...
 (setq P1 (mapcar '- PT1 PT3))
 (setq P2 (mapcar '- PT2 PT3))
 ;; déterminer les valeurs de x1, y1 ...
 (setq
   x1 (car P1)
   x2 (car P2)
   y1 (cadr P1)
   y2 (cadr P2)
 )
 ;; y = ax+b : trouver a et b
 (setq a (/ (- y1 y2) (- x1 x2)))
 (setq b (- y1 (* a x1)))

 ;; en substituant équation droite dans équation cercle on obtient
 ;; (1+a²)x² + 2abx + b² - R² = 0
 ;; ce qui nous donne une belle équation du 2nd degré
 ;; AF*x + BF*x + CF

 (setq AF (+ 1 (* a a)))
 (setq BF (* 2 a b))
 (setq CF (- (* b b) (* R R)))

 (setq D (- (* BF BF) (* 4 AF CF)))

 ;; trouver le (ou les) point(s) d'intersection
 (cond
   ((and (> D -1e-7) (< D 1e-7)) ;; D=0 racine double
     (setq xa (/ BF (* -2 AF)))
     (setq ya (+ (* a xa) b))
     (setq RES (list (mapcar '+ (list xa ya) PT3)))
   )
   ((> D 0) ;; 2 racines distinctes
     (setq xa (/ (+ (sqrt D) BF) (* -2 AF)))
     (setq ya (+ (* a xa) b))
     (setq xb (/ (- (sqrt D) BF) (* 2 AF)))
     (setq yb (+ (* a xb) b))
     (setq RES (list (mapcar '+ (list xa ya) PT3) (mapcar '+ (list xb yb) PT3)))
   )
   (T (setq RES nil))  ;; pas de racine
 )
 RES
)

;; avec polar c'est quand même plus facile !!!

(defun intersDC (PT1 PT2 PT3 R / RES ANG PT4 H)
 ;; intersection droite cercle de façon polaire
 (setq ANG (angle PT1 PT2))
 (setq PT4 (polar PT3 (+ ANG (/ pi 2)) 1.00))
 (setq PT4 (inters PT1 PT2 PT3 PT4 nil))
 (setq H (distance PT3 PT4))
 (setq DC (- R H))
 (cond
   ((and (> DC -1e-7) (< DC 1e-7)) ;; droite et cercle tangents : 1 solution
     (setq RES (list PT4))
   )
   ((> DC 0)  ;; 2 solutions
     (setq A (sqrt (- (* R R) (* H H))))
     (setq RES
       (list
         (polar PT4 (+ ANG PI) A)
         (polar PT4 ANG A)
       )
     )
   )    
   (T (setq RES nil))  ;; pas de solution
 )
 RES  
)

(defun intersCC (PT1 R1 PT2 R2 / RES D DC A H)
 ;; intersection cercle cercle de façon polaire
 (setq D (distance PT1 PT2))
 (setq DC (- (+ R1 R2) D))
 (cond
   ((and (> DC -1e-7) (< DC 1e-7)) ;; 2 cercles tangents : 1 solution
     (setq RES (list (polar PT1 (angle PT1 PT2) R1)))
   )
   ((> DC 0)  ;; 2 solutions
     (setq A (/ (+ (* R1 R1) (* R2 R2 -1) (* D D)) (* 2 D)))
     (setq H (sqrt (- (* R1 R1) (* A A))))
     (setq ALPHA (atan (/ H A)))
     (setq RES (list (polar PT1 (+ (angle PT1 PT2) ALPHA) R1) (polar PT1 (- (angle PT1 PT2) ALPHA) R1)))
   )
   (T (setq RES nil))  ;; pas de solution
 )
 RES
)

(defun c:inters1 ()
 (setq PT1 (getpoint "\nPremier point de la droite : "))
 (setq PT2 (getpoint PT1 "\nDeuxième point de la droite : "))
 (setq PT3 (getpoint "\nCentre du cercle : "))
 (setq R (getdist PT3 "\nValeur du rayon : "))
 (intersDC PT1 PT2 PT3 R)
)

(defun c:inters2 ()
 (setq PT1 (getpoint "\nCentre du 1er cercle : "))
 (setq R1 (getdist PT1 "\nValeur du 1er rayon : "))
 (setq PT2 (getpoint "\nCentre du 2ème cercle : "))
 (setq R2 (getdist PT2 "\nValeur du 2ème rayon : "))
 (intersCC PT1 R1 PT2 R2)
)

Amicalement

Vincent

bonuscad · le 30 mars 2009

Bonjour,

et entre 2 cercles

Je vais te proposer celle qui suit (et qui date...)

Elle m'a bien servie pour du lever d'intérieur; mesures des côtés et des diagonales.

Ainsi avec ces mesures, cela m'évitait de construire les cercle temporaire pour avoir les intersections.

(defun 2xderr (ch)
 (cond
   ((eq ch "Function cancelled") nil)
   ((eq ch "quit / exit abort") nil)
   ((eq ch "console break") nil)
   (T (princ ch))
 )
 (setvar "cmdecho" v1)
 (setvar "orthomode" v2)
 (setvar "osmode" v3)
 (setvar "blipmode" v4)
 (setvar "plinewid" v5)
 (setq *error* olderr)
 (princ)
)
(defun c:2xd ( / v1 v2 v3 v4 v5 cc1 r1 cc2 r2 dce xi yi i cr1 cr2 vi xt yt h1 h2 h i1 i2 ss1 ss2 key olderr)
   (setq v1 (getvar "cmdecho")
         v2 (getvar "orthomode")
         v3 (getvar "osmode")
         v4 (getvar "blipmode")
         v5 (getvar "plinewid")
   ) 
   (setvar "cmdecho" 0)
   (setvar "orthomode" 0)
   (setvar "blipmode" 0)
   (setvar "plinewid" 0)
   (setq olderr *error* *error* 2xderr)	
   (initget 9)
   (setq cc1 (getpoint "\nPremier point de base ?: "))
   (initget 9)
   (setq cc2 (getpoint cc1 "\nDeuxième point de base ?: "))
   (grdraw cc1 cc2 1)
   (initget 39)
   (setq r1 (getdist cc1 "\nDonnez la 1ère distance rayonnante : "))
   (initget 39)
   (setq r2 (getdist cc2 "\nDonnez la 2ème distance rayonnante : "))
   (grdraw cc1 cc2 0)
   (setvar "osmode" 0)
   (setq dce (distance cc1 cc2))
   (if (= (rtos (/ dce (+ r1 r2)) 2 12) "1.000000000000")
       (progn
           (setq xi (/ (+ (* r2 (car cc1)) (* r1 (car cc2))) dce)
                 yi (/ (+ (* r2 (cadr cc1)) (* r1 (cadr cc2))) dce))
           (setq i (cons xi (cons yi '(0.0))))
       )
       (if (and (not (zerop (- r1 r2))) (= (rtos (/ dce (abs (- r1 r2))) 2 12) "1.000000000000"))
           (progn
               (if (= r1 (max r1 r2))
                   (setq cr1 cc1 cr2 cc2)
                   (setq cr1 cc2 cr2 cc1)
               )
               (setq xi (/ (- (* (max r1 r2) (car cr2)) (* (min r1 r2) (car cr1))) dce)
                     yi (/ (- (* (max r1 r2) (cadr cr2)) (* (min r1 r2) (cadr cr1))) dce))
               (setq i (cons xi (cons yi '(0.0))))
           )
           (progn
               (if (or (> dce (+ r1 r2)) (< (+ (min r1 r2) dce) (max r1 r2)))
                   (prompt "\nPas d'intersection !...")
                   (progn
                       (setq vi (angle cc1 cc2))
                       (if (> r1 r2)
                           (setq xt (- (/ (* (+ r1 dce r2) (- (+ r1 dce) r2)) (* 2 dce)) r1)
                                 yt (- dce xt)
                                 h1 (sqrt (- (expt r1 2) (expt xt 2)))
                                 h2 (sqrt (- (expt r2 2) (expt yt 2)))
                                 xi (/ (+ (* yt (car cc1)) (* xt (car cc2))) dce)
                                 yi (/ (+ (* yt (cadr cc1)) (* xt (cadr cc2))) dce)
                           )
                           (setq xt (- (/ (* (+ r2 dce r1) (- (+ r2 dce) r1)) (* 2 dce)) r2)
                                 yt (- dce xt)
                                 h1 (sqrt (- (expt r2 2) (expt xt 2)))
                                 h2 (sqrt (- (expt r1 2) (expt yt 2)))
                                 xi (/ (+ (* xt (car cc1)) (* yt (car cc2))) dce)
                                 yi (/ (+ (* xt (cadr cc1)) (* yt (cadr cc2))) dce)
                           )
                       )
                       (setq h (/ (+ h1 h2) 2)
                             i1 (polar (cons xi (cons yi '(0.0))) (+ vi (/ pi 2)) h)
                             i2 (polar (cons xi (cons yi '(0.0))) (- vi (/ pi 2)) h)
                       )
		(if (zerop (getvar "PICKFIRST")) (setvar "PICKFIRST" 1))
		(command "_.pline" cc1 i1 cc2 "")
		(setq ss1 (ssget "_L"))
		(command "_.pline" cc1 i2 cc2 "")
		(setq ss2 (ssget "_L"))
		(if (and ss1 ss2 (= 0 (getvar "CMDACTIVE"))) 
			(progn
				(sssetfirst nil ss2)
				(princ "\n pour choix; /[Espace]/Click+droit pour finir!.")
				(while (and (not (member (setq key (grread T 4 2)) '((2 13) (2 32)))) (/= (car key) 25))
					(cond
						((eq (car key) 5)
							(if (< (distance i1 (cadr key)) (distance i2 (cadr key)))
								(sssetfirst nil ss1)
								(sssetfirst nil ss2)
							)
						)
					)
				)
			)
		)
		(command "_.erase")
                   )
               )
           )
       )
   )
   (setvar "cmdecho" v1)
   (setvar "orthomode" v2)
   (setvar "osmode" v3)
   (setvar "blipmode" v4)
   (setvar "plinewid" v5)
   (setq *error* olderr)
   (prin1)
)

lili2006 · le 30 mars 2009

Bonsoir à toutes et toutes,

Pfuu, balaise, :P

(gile) · le 30 mars 2009

Salut,

L'idée m'amusait, j'ai fait une routine un peu comme celle de bonuscad.

Comme celle de zebulon_, elle utilise le" théorème de Carnot" qui permet de déterminer les angles d'un triangle quelconque dont on connait les longueurs des côtés.

http://img23.imageshack.us/img23/779/carnot.png

(defun c:test	(/ p1 d1 p2 d2 no pr pt pl)
 (if
   (and
     (setq p1 (getpoint "\nPremier point: "))
     (setq d1 (getdist p1 "\nDistance depuis ce point: "))
     (setq p2 (getpoint p1 "\nDeuxième point: "))
     (setq d2 (getdist p2 "\nDistance depuis ce point: "))
   )
    (if
      (and
 (setq pts (IntersCirc p1 p2 d1 d2))
 (setq no (trans '(0 0 1) 1 0 T))
      )
      (if (cadr pts)
 (progn
   (princ "\nSpécifiez le côté du troisième sommet")
   (while (and (setq gr (grread T 4 0)) (/= (car gr) 3))
     (and pl (entdel pl) (setq pl nil))
     (setq pt (cadr gr)
	   pl (entmakex
		(list
		  '(0 . "LWPOLYLINE")
		  '(100 . "AcDbEntity")
		  '(100 . "AcDbPolyline")
		  '(70 . 0)
		  '(90 . 3)
		  (cons 38 (caddr (trans p1 1 no)))
		  (cons 10 (trans p1 1 no))
		  (cons	10
			(if (clockwise-p p1 p2 pt)
			  (trans (cadr pts) 1 no)
			  (trans (car pts) 1 no)
			)
		  )
		  (cons 10 (trans p2 1 no))
		  (cons 210 no)
		)
	      )
     )
   )
 )
 (entmake
   (list
     '(0 . "LWPOLYLINE")
     '(100 . "AcDbEntity")
     '(100 . "AcDbPolyline")
     '(70 . 0)
     '(90 . 3)
     (cons 38 (caddr (trans p1 1 no)))
     (cons 10 (trans p1 1 no))
     (cons 10 (trans (car pts) 1 no))
     (cons 10 (trans p2 1 no))
     (cons 210 no)
   )
 )
      )
      (princ "\nAucune intersection")
    )
 )
 (princ)
)


;; IntersCirc
;; Retourne la liste des (ou du) points d'intersection de deux cercles
;;
;; Arguments
;; p1 : centre du premier cercle
;; p2 : centre du deuxième cercle
;; d1 : rayon du premier cercle
;; d2 : rayon du deuxième cercle

(defun IntersCirc (p1 p2 d1 d2 / d0)
 (setq	d0 (distance p1 p2)
a0 (angle p1 p2)
 )
 (cond
   ((or (equal d0 (+ d1 d2) 1e-9) (equal d1 (+ d0 d2) 1e-9))
     (list (polar p1 a0 d1))
   )
   ((equal d2 (+ d1 d0) 1e-9) (list (polar p1 (+ pi a0) d1)))
   ((     (setq a1 (acos (/ (- (+ (* d1 d1) (* d0 d0)) (* d2 d2))
	       (* 2 d1 d0)
	    )
      )
    )
    (list (polar p1 (+ a0 a1) d1) (polar p1 (- a0 a1) d1))
   )
 )
)

;; ACOS
;; Retourne le cosinus du nombre, en radians
;;
;; Argument : un entier compris entre -1 et 1

(defun ACOS (num)
 (cond
   ((equal num 1 1e-9) 0.0)
   ((equal num -1 1e-9) pi)
   ((     (atan (sqrt (- 1 (expt num 2))) num)
   )
 )
)

;; Clockwise-p
;; Retourne T si les points p1 p2 et p3 tournent dans le sens horaire

(defun clockwise-p (p1 p2 p3)
 ()

lili2006 · le 30 mars 2009

Re,

" théorème de Carnot"

Jamais entendue parler (honte à moi !)

al Kashi ou phythagore "généralisé', même combat ?

Marche parfaitement, super !!! :D

PS: Ne ferme pas le triangle, normal ??

(gile) · le 30 mars 2009

J'avais quelque part que c'est le "théorème de Carnot" mais c'est peut être faux (il ne faut pas croire tout ce qui est écrit).

PS: Ne ferme pas le triangle, normal ??

J'ai voulu imiter la routine de bonuscad, mais il suffit de remplacer '(70 . 0) par '(70 . 1) dans la liste entmakex et la polyligne sera fermée.

EDIT (erratum) : En fait le théorème de Carnot, ça a bien quelque chose à avoir avec les triangle mais c'est pas ça. :calim:

Il s'agit bien du théorème d'Al-Kashi (généralisation du théorème de Pythagore), au temps pour moi.

zebulon_ · le 31 mars 2009

Bonjour,

Bel échange, comme on dirait au tennis. ;)

(defun IntersCirc (p1 p2 d1 d2 / d0) de (Gille) ressemble pas mal sur le principe au (defun intersCC (PT1 R1 PT2 R2 / RES D DC A H), à part que j'utilise la fonction ATAN (qui est disponible) plutôt que ACOS (qui curieusement ne l'est pas).

Tout cela pour dire que nous ne remercierons jamais assez celui qui a été assez génial pour inventer la fonction polar

Amicalement

Vincent

(gile) · le 31 mars 2009

Salut,

j'utilise la fonction ATAN (qui est disponible) plutôt que ACOS (qui curieusement ne l'est pas).

C'est pour ça que je me suis fait 2 fonctions : ACOS et ASIN qui utilisent ATAN.

;;; ASIN et ACOS Retournent l'arc sinus ou cosinus du nombre, en radians

(defun ASIN (num)
 (cond
   ((equal num 1 1e-9) (/ pi 2))
   ((equal num -1 1e-9) (/ pi -2))
   ((     (atan num (sqrt (- 1 (expt num 2))))
   )
 )
)

(defun ACOS (num)
 (cond
   ((equal num 1 1e-9) 0.0)
   ((equal num -1 1e-9) pi)
   ((     (atan (sqrt (- 1 (expt num 2))) num)
   )
 )
)

lili2006 · le 31 mars 2009

Bonjour à toutes et tous,

(il ne faut pas croire tout ce qui est écrit).

Oui, bien sûr,..

En même temps on ne connait pas tout et on utilise aussi souvent des termes par "abus de language",...

mais il suffit de remplacer '(70 . 0) par '(70 . 1)

Vu,

Merci (gile)

PHILPHIL · le 5 mai 2022

hello

j'utilise "intersDC" de ZEBULON dans un lisp pour trouver le(s) point(s) de croisement entre une ligne et un cercle.

il me donne deux points, ce qui est logique. je comprend. meme si la ligne ne coupe qu'une seule fois le cercle.

mais si je ne voulais que le point de coupe entre une ligne qui ne coupe le cercle que UNE SEULE fois ?

comment faut il modifier le lisp "intersdc" ?

ou dois je vérifier apres coup lequel des deux points ( "C" et "D" ) se trouve entre les deux points de cette ligne ( "A" et "B" ).

si la distance "AC" + "BC" est supérieure a la distance "AB" alors "C" n'est pas entre "A" et "B" ( ou avez vous une autre méthode plus "CARTESIENNE" plus jolie ?)

MERCI

Phil

Luna · le 5 mai 2022

Coucou,

Il me semble que cela provient de la fonction (inters), qui possède un argument non-obligatoire [onseg]. Si on précise nil pour cet argument, les segments seront considérés comme étant infinis alors que si on l'omet ou différent de nil, les segments seront considérés comme finis.

Citation
inters (AutoLISP)
Finds the intersection of two lines

Supported Platforms: Windows and Mac OS
Signature
(inters pt1 pt2 pt3 pt4 [onseg])
pt1

Type: List

One endpoint of the first line.

pt2

Type: List

The other endpoint of the first line.

pt3

Type: List

One endpoint of the second line.

pt4

Type: List

The other endpoint of the second line.

onseg

Type: List or nil

If specified as nil, the lines defined by the four pt arguments are considered infinite in length. If the onseg argument is omitted or is not nil, the intersection point must lie on both lines or inters returns nil.
Return Values

Type: List or nil

If the onseg argument is present and is nil, inters returns the point where the lines intersect, even if that point is off the end of one or both of the lines. If the onseg argument is omitted or is not nil, the intersection point must lie on both lines or inters returns nil. The inters function returns nil if the two lines do not intersect.

Donc je dirais qu'il te suffit de supprimer le nil à la fin de la fonction (inters) ? Je ne fais que supposer évidemment ^^"

Bisous,
Luna

Connexion

Intersection droite/cercle droite/droite

Messages recommandés

zebulon_

bonuscad

lili2006

(gile)

lili2006

(gile)

zebulon_

(gile)

lili2006

PHILPHIL

Luna

inters (AutoLISP)

Signature

Return Values

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Forums

Naviguer

Activité

Information importante