Author Topic: -={ Challenge }=- 3-Point Circle Tangent to Two Circles, with given Point.  (Read 19480 times)

0 Members and 1 Guest are viewing this topic.

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: -={ Challenge }=- 3-Point Circle Tangent to Two Circles, with given Point.
« Reply #30 on: October 04, 2011, 06:00:53 AM »
Yes, my mistake, both functions are OK... I was mistyping (forgot c: before ci1xci2 so my code was loaded instead, and then there haven't been specified all possibilities of 2 circle relations in my "if" statements, so I thought that your subfunction was wrong)... My apology...

M.R.

Still check this case - see picture... Your returns nil or gives 2 point list with both points identical, and mine single point list... When circles are touching from outside then your gives also 2 point list with both points identical, mine one point list.
« Last Edit: October 04, 2011, 07:19:34 AM by ribarm »
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: -={ Challenge }=- 3-Point Circle Tangent to Two Circles, with given Point.
« Reply #31 on: October 04, 2011, 07:55:47 AM »
Revised code for CCC - check my updated *.lsp

http://www.theswamp.org/index.php?topic=39567.msg449135#msg449135

M.R.

(FINAL RELEASE - REVISED CI1XCI2 AND CIXLI SUBFUNCTIONS)
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

chlh_jd

  • Guest
Re: -={ Challenge }=- 3-Point Circle Tangent to Two Circles, with given Point.
« Reply #32 on: October 09, 2011, 03:05:14 PM »
my new version
Code: [Select]
;;;===================================================================================================
;;;thp-t2c
(defun c:t3 (/ ppp_circle foo f1  cir1 cir2 pnt ent1 ent2 r1 r2 cen1 cen2 ang r1r2 off d1 d2 p11 p12 p21 p22 tp11 tp12 tp21 tp22 circle_lst i)
  ;;the method is seach all can be recursized circles , recursize loops is limited to get a possible circle , Now use 20 times .
  ;;code by GSLS(SS) 2011-10-10
  ;;I just test all case which I have found , welcome any suggest .
 (defun ppp_circle (P0 P1 P2 / X0 Y0 X1 Y1 X2 Y2 DX1 DY1 DX2 DY2 D 2D C1 C2 CE)
    ;;by highflybird
    (if (and p0 p1 p2 (> (abs (ss-get-d p0 p1 p2)) 1e-3));_add judge
      (progn
    (setq X0  (car P0)
  Y0  (cadr P0)
  X1  (car P1)
Y1  (cadr P1)
X2  (car P2)
Y2  (cadr P2)
DX1 (- X1 X0)
DY1 (- Y1 Y0)
DX2 (- X2 X0)
DY2 (- Y2 Y0)
  )
  (setq D (- (* DX1 DY2) (* DX2 DY1)))
   (setq 2D (+ D D)
    C1 (+ (* DX1 (+ X0 X1)) (* DY1 (+ Y0 Y1)))
    C2 (+ (* DX2 (+ X0 X2)) (* DY2 (+ Y0 Y2)))
    CE (List (/ (- (* C1 DY2) (* C2 DY1)) 2D)
     (/ (- (* C2 DX1) (* C1 DX2)) 2D)
       )
      )
      (list CE (distance CE P0)))))
  (defun foo (cr1 / i% cr1 is_go pl1 pl2 mp1 mp2)
    ;; Using  Asymptotic method 
    ;; edited from highflybird's code , by GSLS(SS)
    (if cr1
      (setq is_go T
    i% 0)
    )
    (while (and is_go cr1)
      (setq pl1 (C_INT_C (car cr1) (cadr cr1) cen1 r1)
    pl2 (C_INT_C (car cr1) (cadr cr1) cen2 r2)
      )
      (cond ((and pl1 (cadr pl1))
     (setq mp1 (midpt (car pl1) (cadr pl1)))
    )
    (pl1 (setq mp1 (car pl1)))    
      )
      (cond ((and pl2 (cadr pl2))
     (setq mp2 (midpt (car pl2) (cadr pl2)))
    )
    (pl2 (setq mp2 (car pl2)))    
      )     
      (if (or (and (not pl1) (not pl2))
      (and (not (cadr pl1)) (not (cadr pl2)))
      (and (equal (car pl1) (cadr pl1) 1e-3)
   (equal (car pl2) (cadr pl2) 1e-3)
      )
      (not mp1)
      (not mp2)
  )
(setq is_go nil)
(setq cr1
      (ppp_circle pnt
(mapcar '+
cen1
(pt* (v2u (mapcar '- mp1 cen1)) r1)
)
(mapcar '+
cen2
(pt* (v2u (mapcar '- mp2 cen2)) r2)
)
      )
       )
      )
      (setq i% (1+ i%))
      (if (> i%  20)
(setq is_go nil
      cr1 nil))
    )
    cr1
  );_(entmakex (list (cons 0 "circle") (cons 10 (car cr1)) (cons 40 (cadr cr1)) (cons 62 1)))
  (defun f1 (pnt p cen rad)
    ;;get tangent circle first recurvsize point .
    (car (vl-sort (L_INT_C pnt p cen rad)
      (function (lambda (e1 e2)
  (> (distance p e1)  (distance p e2))
  ))
      ))
    )
  (setq cir1 (car (entsel "\nPick a circle:")))
  (setq cir2 (car (entsel "\nPick another circle:")))
  (setq pnt (getpoint "\nPick a point:"))
  (if (not (and cir1 cir2 pnt))
    (progn (princ "\nselection is not enough .") (exit))
  )
  (setq ent1 (entget cir1)
ent2 (entget cir2)
r1 (cdr (assoc 40 ent1))
r2 (cdr (assoc 40 ent2))
cen1 (cdr (assoc 10 ent1))
cen2 (cdr (assoc 10 ent2))
ang (angle cen1 cen2)
r1r2 (distance cen1 cen2) ;_wheelbase
off  (ss-get-d pnt cen1 cen2) ;_off_axis distance
d1 (distance pnt cen1)
d2 (distance pnt cen2)
  )
  (setq p11 (polar cen1 (+ ang (/ pi 2.)) r1)
p12 (polar cen1 (- ang (/ pi 2.)) r1)
p21 (polar cen2 (+ ang (/ pi 2.)) r2)
p22 (polar cen2 (- ang (/ pi 2.)) r2)
)
  (setq tp11 (f1 pnt p11 cen1 r1)
tp12 (f1 pnt p12 cen1 r1)
tp21 (f1 pnt p21 cen2 r2)
tp22 (f1 pnt p22 cen2 r2))
 
  (cond
    ;;the 2 circles not intersected , point out of them
    ((and (> r1r2 (+ r1 r2)) (> d1 r1 ) (> d2 r2))
      (cond ((<= (abs off) 1e-3)
     (setq circle_lst (mapcar (function (lambda (cr0)
(foo cr0)
)
       )
     (list (ppp_circle pnt tp11 tp21)
   (ppp_circle pnt tp12 tp22)
   (ppp_circle pnt tp11 tp22)
   (ppp_circle pnt tp12 tp21)
   (ppp_circle pnt p11 tp21)
     )
     )
  ))
     (t
       (setq circle_lst (mapcar (function (lambda (cr0)
(foo cr0)
)
       )
     (list (ppp_circle pnt tp11 tp21)
   (ppp_circle pnt tp12 tp22)
   (ppp_circle pnt tp11 tp22)
   (ppp_circle pnt tp12 tp21)    
   (ppp_circle pnt p11 tp21)
   (ppp_circle pnt p11 tp22)
   (ppp_circle pnt p12 tp21)
   (ppp_circle pnt p12 tp22)
   (ppp_circle pnt tp11 p21)
   (ppp_circle pnt tp11 p22)
   (ppp_circle pnt tp12 p21)
   (ppp_circle pnt tp12 p22)
   (ppp_circle pnt (polar cen1 ang (- r1)) (polar cen2 ang r2))
     )
     )
  )) )     
     )
    ;;point at one circle and at the centers-line
    ((and (> r1r2 (+ r1 r2)) (equal (+ d1 d2)  r1r2 1e-6) (or (equal d1 r1 1e-6) (equal d2 r2 1e-6)))       
       (setq circle_lst ((lambda (p1 p2)
   (list (list (midpt p1 p2) (/ (distance p1 p2) 2.)))
   )
  (polar cen1 ang r1)
  (polar cen2 ang (- r2))
  )
     )
     )
    ;;point at one circle and at the centers-line , 2nd case
    ((and (<= (abs (- r1 r2)) r1r2) (or (and (equal (+ d1 r1r2 ) d2 1e-6) (equal d1 r1 1e-6)) (and (equal (+ d2 r1r2 ) d1 1e-6) (equal d2 r2 1e-6))))     
       (setq circle_lst ((lambda (p1 p2)
   (list (list (midpt p1 p2) (/ (distance p1 p2) 2.)))
   )
  (polar cen2 ang r2)
      (polar cen1 ang (- r1))
  )
     )
     )
    ;;the 2 circles intersected , point out of them
    ((and (<= (abs (- r1 r2)) r1r2 (+ r1 r2))(> d1 r1 ) (> d2 r2))
     (cond ((and (<= (abs off) 1e-6)
(or (equal r1 r2 1e-6)
        (and (> r1 r2) (< d1 d2))
(and (> r1 r2) (> d1 d2)      
     (<= d2 (distance (inters p11 p21 p12 p22 nil) cen2))
)
(and (< r1 r2) (> d1 d2))
(and (< r1 r2) (< d1 d2)      
     (<= d1 (distance (inters p11 p21 p12 p22 nil) cen1))
)))(princ "\nPoint error ."));_no result    
           ((<= (abs off) 1e-6);_at the centers-line
    (setq circle_lst (list (ppp_circle pnt (polar cen1 (angle cen1 (pedal_to_line cen1 tp11 tp21)) r1) (polar cen2 (angle cen2 (pedal_to_line cen2 tp11 tp21)) r2))
   (ppp_circle pnt (polar cen1 (angle cen1 (pedal_to_line cen1 tp12 tp22)) r1) (polar cen2 (angle cen2 (pedal_to_line cen2 tp12 tp22)) r2))
     )
  )    
   )
   (t (setq circle_lst (mapcar (function (lambda (cr0)
(foo cr0)
)
       )
     (list (ppp_circle pnt tp11 tp21)
   (ppp_circle pnt tp12 tp22)
                                                                            (ppp_circle pnt p11 p21)
   (ppp_circle pnt p12 p22)
     )
     )
  ))
     )
    )
    ;;the 2 circles intersected , point in one or two of them
    ((and (< (abs (- r1 r2)) r1r2 (+ r1 r2)) (or (and (< d1 r1 ) (/= d2 r2)) (and (/= d1 r1) (< d2 r2))))
     (setq circle_lst (mapcar (function (lambda (cr0)
(foo cr0)
)
       )
     (list (ppp_circle pnt tp11 tp22)
   (ppp_circle pnt tp12 tp21)
   (ppp_circle pnt p11 tp21)
   (ppp_circle pnt p11 tp22)
   (ppp_circle pnt p12 tp21)
   (ppp_circle pnt p12 tp22)
   (ppp_circle pnt tp11 p21)
   (ppp_circle pnt tp12 p21)
   (ppp_circle pnt tp11 p22)
   (ppp_circle pnt tp12 p22)
     )
     )
  )
    )
    ;;1st just contain 2nd , point not in the smaller circle .
    ((and (<= r1r2 (abs (- r1 r2))) (> r1 r2) (< d1 r1) (> d2 r2) (equal (+ r1r2 r2) r1 1e-6))
     (setq circle_lst
    (cons ((lambda (p / mp a c r)
       (setq mp (midpt p pnt)
     a (+ (angle pnt p) (/ pi 2.))
     c (inters mp (polar mp a 1e3) cen1 cen2 nil)
     r (distance c pnt))
       (list c r))
      (polar cen2 ang r2)
      )
         (mapcar (function (lambda (x)
(foo x)))
     (list (ppp_circle pnt p11 tp21)
   (ppp_circle pnt p11 tp22)
   (ppp_circle pnt p12 tp22)
   (ppp_circle pnt p12 tp21)
   (ppp_circle pnt tp11 tp22)
   (ppp_circle pnt tp12 tp21)
   (ppp_circle pnt tp11 tp21)
   (ppp_circle pnt tp12 tp22)
     ))      
  )
   )
     )
    ;;2nd just contain 1st , point not in the smaller circle .
    ((and (<= r1r2 (abs (- r1 r2))) (< r1 r2) (> d1 r1) (< d2 r2) (equal (+ r1r2 r1) r2 1e-6))
     (setq circle_lst
    (cons ((lambda (p / mp a c r)
       (setq mp (midpt p pnt)
     a (+ (angle pnt p) (/ pi 2.))
     c (inters mp (polar mp a 1e3) cen1 cen2 nil)
     r (distance c pnt))
       (list c r))
      (polar cen1 (+ ang pi) r1)
      )
         (mapcar (function (lambda (x)
(foo x)))
     (list (ppp_circle pnt tp11 p21)
   (ppp_circle pnt tp12 p22)
   (ppp_circle pnt tp11 p22)
   (ppp_circle pnt tp12 p21)
   (ppp_circle pnt tp11 tp22)
   (ppp_circle pnt tp12 tp21)
   (ppp_circle pnt tp11 tp21)
   (ppp_circle pnt tp12 tp22)
     ))      
  )
   )
     )
    ;;1st contain 2nd , point not in the smaller circle .
     ((and (<= r1r2 (abs (- r1 r2))) (> r1 r2) (< d1 r1) (> d2 r2) (not (equal (+ r1r2 r2) r1 1e-6)))
     (setq circle_lst (mapcar (function (lambda (cr0)
(foo cr0)
)
       )
     (list (ppp_circle pnt tp11 tp21)
   (ppp_circle pnt tp12 tp22)
   (ppp_circle pnt tp11 tp22)
   (ppp_circle pnt tp12 tp21)
   (ppp_circle pnt p11 tp21)
   (ppp_circle pnt p12 tp21)
   (ppp_circle pnt p11 tp22)
   (ppp_circle pnt p12 tp22)
   (ppp_circle pnt p11 p22)
   (ppp_circle pnt p12 p21)
     )
     )
  )
     )
    ;;2nd contain 1st , point not in the smaller circle .
    ((and (<= r1r2 (abs (- r1 r2))) (< r1 r2) (> d1 r1) (< d2 r2) (not (equal (+ r1r2 r1) r2 1e-6)))
     (setq circle_lst (mapcar (function (lambda (cr0)
(foo cr0)
)
       )
     (list (ppp_circle pnt tp11 tp21)
   (ppp_circle pnt tp12 tp22)
   (ppp_circle pnt tp11 tp22)
   (ppp_circle pnt tp12 tp21)
   (ppp_circle pnt tp11 p21)
   (ppp_circle pnt tp12 p21)
   (ppp_circle pnt tp11 p22)
   (ppp_circle pnt tp12 p22)
   (ppp_circle pnt p11 p22)
   (ppp_circle pnt p12 p21)
     )
     )
  )
     )
  )
  (setq circle_lst (remove-eq-doubles circle_lst 1e-3))
  (setq i 0)
  (if circle_lst
    (mapcar (function (lambda (x)
(entmake (list (cons 0 "CIRCLE")
     (cons 10 (car x))
     (cons 40 (cadr x))
     (cons 62 (setq i (1+ i)))))))
    circle_lst))
  (princ)
)
(defun midpt (pta ptb)
  (mapcar (function (lambda (x y)
      (/ (+ x y) 2.0)
    )
  )
  pta
  ptb
  )
)
;;; unit vector
(defun v2u (v / l)
  (setq l (distance (list 0 0 0) v))
  (if (/= l 0)
    (mapcar (function (lambda (x) (/ x l))) v)
  )
)
;;line intersect with circle
(defun L_Int_C (pt1 pt2 cen rad / pt dis)
  ;;by w_kai
  (setq pt  (inters
      cen
      (polar cen (+ (/ pi 2) (angle pt1 pt2)) 1.)
      pt1
      pt2
      nil
    )
dis (distance pt cen)
  )
  (cond
    ((equal rad dis) (list pt))
    ((> rad dis)
     (list (polar pt
  (angle pt1 pt2)
  (sqrt (- (* rad rad) (* dis dis)))
   )
   (polar pt
  (+ pi (angle pt1 pt2))
  (sqrt (- (* rad rad) (* dis dis)))
   )
     )
    )
    (t nil)
  )
)
;;;circle intersect with circle
(defun C_Int_C (ce1 r1 ce2 r2 / dis a b)
  ;;by w_kai
  (setq dis (distance ce1 ce2))
  (cond
    ((equal dis (+ r1 r2))
     (list (polar ce1 (angle ce1 ce2) r1))
    )
    ((equal dis (abs (- r1 r2)))
     (if (minusp (- r1 r2))
       (list (polar ce2 (angle ce2 ce1) r2))
       (list (polar ce1 (angle ce1 ce2) r1))
     )
    )
    ((and (> dis (abs (- r1 r2)))
  (< dis (+ r1 r2))
     )
     (setq a (/ (- (+ (* dis dis) (* r1 r1))
   (* r2 r2)
)
(* 2. dis)
     )
     )
     (setq b (sqrt (max 0 (- (* r1 r1) (* a a)))))
     (list (polar (polar ce1 (angle ce1 ce2) a)
  (+ (angle ce1 ce2) (/ pi 2))
  b
   )
   (polar (polar ce1 (angle ce1 ce2) a)
  (- (angle ce1 ce2) (/ pi 2))
  b
   )
     )
    )
  )
)
(defun pt* (pt1 sc)
  (mapcar (function (lambda (x)
      (* x sc)
    )
  )
  pt1
  )
)
(defun ss-get-d (pt p1 p2)
  (car (trans (mapcar (function -) pt p2) 0 (mapcar (function -) p1 p2)))
)
(defun pedal_to_line (p p1 p2)
  (inters
    p
    (polar pt (+ (/ pi 2.) (angle p1 p2)) 1e3)
    p1
    p2
    nil
  )
)
(defun remove-eq-doubles (lst tor / f1)
  (defun f1 (a lst tor)
    (cond
      ((> (length lst) 1)
       (if (or (not (car lst))
       (vl-some (function (lambda (x) (equal x (car lst) tor)))
(cdr lst)
       )
   )
(f1 a (cdr lst) tor)
(f1 (cons (car lst) a) (cdr lst) tor)
       )
      )
      (t
       (if (car lst)
(cons (car lst) a)
a
       )
      )
    )
  )
  (reverse (f1 nil lst tor))
)

« Last Edit: October 09, 2011, 03:37:22 PM by chlh_jd »

Ketxu

  • Newt
  • Posts: 109
Re: -={ Challenge }=- 3-Point Circle Tangent to Two Circles, with given Point.
« Reply #33 on: October 09, 2011, 11:22:30 PM »
Thanks you chlh_jd ^^ I'm wondering what is practical applications of this rountine ? Is it useful for Mechanical Engineer ?

chlh_jd

  • Guest
Re: -={ Challenge }=- 3-Point Circle Tangent to Two Circles, with given Point.
« Reply #34 on: October 10, 2011, 01:23:42 AM »
Thanks you chlh_jd ^^ I'm wondering what is practical applications of this rountine ? Is it useful for Mechanical Engineer ?
You'er welcome .
I'm not sure it has much useful for Mechanial Engineer , It's just for fun .
A nice way is offten by xyp-1964 and Evgeniy .
Code: [Select]
(defun c:test () (vl-cmdf "_circle" "_3p" "_tan" pause "_tan" pause pause))

pBe

  • Bull Frog
  • Posts: 402
Re: -={ Challenge }=- 3-Point Circle Tangent to Two Circles, with given Point.
« Reply #35 on: October 10, 2011, 04:11:59 AM »
Would love to partake on this challenge, but maybe later :)

Must learn to face my fear Geometry and Trigonometry

I will write a code at any cost, sign of courage
unlike a charlatan, gently faking his way
I'm an ensign when it comes to match

:)


« Last Edit: October 11, 2011, 01:23:25 AM by pBe »

Stefan

  • Bull Frog
  • Posts: 319
  • The most I miss IRL is the Undo button
Re: -={ Challenge }=- 3-Point Circle Tangent to Two Circles, with given Point.
« Reply #36 on: November 01, 2011, 03:39:22 PM »
Nice challenge Lee.
I have tried to find some mathematical solution but no success yet...
Instead I used the intersection of 2 conics (hyperbole or ellipses) to find the centers of circles.
First image illustrate the solution and the second, what is behind the scene...
The lisp is using grread function and I chose to delete and recreate objects instead of grvecs or grdraw,
so my AutoCAD ran "out of memory"several times. For that reason, USE IT ON YOUR OWN RISK...
Thinking of entmoding objects instead of enmake and endel every time, but maybe some other day...




Stefan

  • Bull Frog
  • Posts: 319
  • The most I miss IRL is the Undo button
Re: -={ Challenge }=- 3-Point Circle Tangent to Two Circles, with given Point.
« Reply #37 on: November 03, 2011, 09:38:19 AM »
New version.

[Edit] Fixed for Autocad 2012
« Last Edit: November 04, 2011, 02:06:16 AM by Stefan »