« previous next »
Pages: 1 2 3 [All] |   Go Down

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

0 Members and 1 Guest are viewing this topic.

Lee Mac

  • Seagull
  • Posts: 12912
  • London, England
-={ Challenge }=- 3-Point Circle Tangent to Two Circles, with given Point.
« on: September 24, 2011, 10:25:47 AM »
This was a question posed at the AUGI forums, the user wanted to automate the process of creating a circle tangent to two other circles, given a point on the circumference.

I posted a solution involving a command call to the 'tan' snap, but was disappointed that I could not construct a geometric solution and so thought it would be a good challenge to post here.

The Challenge:

Given circles A & B and a point P, construct a circle C tangent to both A & B, such that P lies on the circumference:



I believe there are four possible solutions...

Logged

Ketxu

  • Newt
  • Posts: 109
Re: -={ Challenge }=- 3-Point Circle Tangent to Two Circles, with given Point.
« Reply #1 on: September 25, 2011, 12:48:36 PM »
I'm not good in geometric, can this link be useful to you :(

http://whistleralley.com/tangents/tangents.htm
Logged

Lee Mac

  • Seagull
  • Posts: 12912
  • London, England
Re: -={ Challenge }=- 3-Point Circle Tangent to Two Circles, with given Point.
« Reply #2 on: September 25, 2011, 02:47:19 PM »
Well, the general equation for the solution is the intersection of three circles:



The intersection is the solution(s) of the following three simultaneous equations, solved for x, y, r:

(x - Ax)2 + (y - Ay)2 = (r + Ar)2
(x - Bx)2 + (y - By)2 = (r + Br)2
(x - Px)2 + (y - Py)2 = r2

Where:

Centre of circle A is (Ax, Ay), with radius Ar
Centre of circle B is (Bx, By), with radius Br
Point P has coordinates (Px, Py)

Resultant Circle has centre (x,y) and radius r.

It just remains to rearrange the equations into a closed expression...
Logged

ribarm

  • Gator
  • Posts: 3249
  • Marko Ribar, architect
Re: -={ Challenge }=- 3-Point Circle Tangent to Two Circles, with given Point.
« Reply #3 on: September 26, 2011, 05:19:25 AM »
I've studied posted link and find it vary useful for those that wants to work with constructions... Based on explanations of constructions, I did what was explained - draw circles that tangents three other circles... I know this topic is about tan+tan+pt, but precise drawings may also satisfy someones needs...

M.R.

Lee, for constructing your example you must firstly calculate radius of solution circle, and when obtained radius routine may find intersections of 3 given circles, but unfortunately that's not construction you search for...

Regards, Marko Ribar, d.i.a. (architect)
Logged
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Gator
  • Posts: 3249
  • Marko Ribar, architect
Re: -={ Challenge }=- 3-Point Circle Tangent to Two Circles, with given Point.
« Reply #4 on: September 26, 2011, 06:45:33 AM »
Maybe this can be of some help... DWG shows all relations between 2 circles (dilatation points, radical axis, poles on circles from radical axis). I've drawn yellow circles that passes through 2 points on direction cent1 - cent2 and that have various centers along radical axis...
As an example for tangent circles I used 2 dilatation lines (2 tangent circles solutions for each line - 4 circles (2 green) (2 cyan))...

Regards, M.R.
Logged
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

highflyingbird

  • Bull Frog
  • Posts: 415
  • Later equals never.
Re: -={ Challenge }=- 3-Point Circle Tangent to Two Circles, with given Point.
« Reply #5 on: September 26, 2011, 07:03:52 AM »
here is my code.
Actually , a few months ago, I wanted to find a lisp to replace the command "circle  3P".so I made it.I finished most of cases. I will show my stuff  a few days later.

Code: [Select]
;;; for test
(defun c:PCC(/ cir1 cir2 pnt dxf1 dxf2 rad1 rad2 cen1 cen2 ret)
  (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))
    (exit)
  )
  (setq dxf1 (entget cir1))
  (setq dxf2 (entget cir2))
  (setq rad1 (cdr (assoc 40 dxf1)))
  (setq rad2 (cdr (assoc 40 dxf2)))
  (setq cen1 (cdr (assoc 10 dxf1)))
  (setq cen2 (cdr (assoc 10 dxf2)))


  (setq ret (PCC_Circle pnt rad1 cen1 rad2 cen2))
  (makePoint pnt)
  (if (car ret)
    (progn
      (makecircle (caadr ret) (cadadr ret))
      (makecircle (caar ret) (cadar ret))
    )
  )
)

;;;直线的方程
(defun Coefficient_Equation (p1 p2)
  (list (- (cadr p1) (cadr p2))
(- (car  p2) (car  p1))
(- (* (car p1) (cadr p2))
   (* (cadr p1) (car p2))
)
  )
)

;;;位似中心
(defun Homothetic_center (rad1 cen1 rad2 cen2 / r1 c1 r2 c2 l d)
  (if (< rad1 rad2)
    (setq r1 rad1
  c1 cen1
  r2 rad2
  c2 cen2
    )
    (setq r1 rad2
  c1 cen2
  r2 rad1
  c2 cen1
    )
  )
  (setq l (distance c1 c2))
  (setq d (- r2 r1))
  (cond
    ( (or (< l d) (= l 0.0)) nil)
    ( (equal l d 1e-8) (list nil (polar c1 (angle c2 c1) r1)))
    ( (equal r1 r2 1e-14)
      (if (>= l (+ r1 r2))
        (list nil (mtp c1 c2))
      )
    )
    (t
      (if (< l (+ r1 r2))
(list (polar c1 (angle c2 c1) (/ (* r1 l) (- r2 r1))) nil)
(list (polar c1 (angle c2 c1) (/ (* r1 l) (- r2 r1)))
      (polar c1 (angle c1 c2) (/ (* r1 l) (+ r2 r1)))
)
      )
    )
  )
)

;;;点对圆的反演
(defun Point_Inversion (rad cen p)
  (setq d (distance p cen))
  (if (/= d 0)
    (polar cen (angle cen p) (/ (* rad rad) d))
  )
)

;;;线段对圆的反演
(defun Line_Inversion (Rad Cen P1 P2 /)
  (if (equal (det cen p1 p2) 0.0 1e-8)
    (list p1 p2)
    (PPP_Circle cen (Point_Inversion rad cen p1) (Point_Inversion rad cen p2))
  )
)

;;;圆对圆的反演
(defun Circle_Inversion (Rad Cen R C / an p1 p2)
  (setq an (angle C Cen))
  (setq p1 (polar C an R))
  (setq p2 (polar C an (- R)))
 
  (setq p1 (Point_Inversion Rad Cen P1))
  (setq p2 (Point_Inversion Rad Cen P2))
  (cond
    ( (and p1 p2)
      (list (mtp p1 p2) (/ (distance p1 p2) 2))
    )
    ( p1
      (list p1 (mapcar '+ p1 (rot90 (mapcar '- p1 Cen))))
    )
    ( p2
      (list p2 (mapcar '+ P2 (rot90 (mapcar '- P2 Cen))))
    )
  )
)

;;;圆外的一点对圆形的切点OK
(defun Tangent_Point (rad cen pt / d l a b p q r)
  (setq d (distance cen pt))
  (if (> d rad)
    (setq l (sqrt (- (* d d) (* rad rad)))
  a (atan l rad)
  b (angle cen pt)
  p (polar cen (+ b a) rad)
  q (polar cen (- b a) rad)
  r (list p q)
    )
    (if (= d rad)
      pt
    )
  )
)

;;; 三点圆函数OK
(defun PPP_Circle(P0 P1 P2 / X0 Y0 X1 Y1 X2 Y2 DX1 DY1 DX2 DY2 D 2D C1 C2 CE)
  (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)))
  (if (/= D 0.0)
    (progn
      (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 PPP_Circle_1(p1 p2 p3 / m1 m2 m3 v1 v2 v3 r1 r2 r3)
  (setq m1 (mtp p2 p3))
  (setq m2 (mtp p3 p1))
  (setq m3 (mtp p1 p2))
  (setq v1 (mapcar '- p3 p2))
  (setq v2 (mapcar '- p1 p3))
  (setq v3 (mapcar '- p2 p1))
  (setq r1 (mapcar '+ m1 (rot90 v1)))
  (setq r2 (mapcar '+ m2 (rot90 v2)))
  (setq r3 (mapcar '+ m3 (rot90 v3)))
  (setq c  (inters m1 r1 m2 r2 nil))
  (if c
    (list c (distance c p3))
  )
)

;;;点点切的圆(不相同的点)
(defun PPC_Circle(p1 p2 rad cen / InvP1 InvP2 IntPt Pair Tan1 Tan2 ret an HalfPi PA PB dd hh)
  (cond
    ( (equal p1 p2 1e-8) nil)
    ( (or (equal p1 cen 1e-8)
  (equal p2 cen 1e-8)
      )
      (if (equal p1 cen 1e-8)
        (setq pA p1 pB p2)
        (setq pA p2 pB p1)
      )
      (setq an (+ (angle p1 p2) (/ pi 2)))
      (setq dd (distance p1 p2))
      (setq HH (sqrt (- (* rad rad) (* dd dd))))
      (setq tan1 (polar pB an HH))
      (setq tan2 (polar pB an (- HH)))
      (list (list (mtp cen tan1) (/ rad 2))
    (list (mtp cen tan2) (/ rad 2))
      )
    )
    (t   
      (setq InvP1 (Point_Inversion rad cen p1))
      (setq InvP2 (Point_Inversion rad cen p2))
      (setq IntPt (inters invP1 invP2 p1 p2 nil))
      (if IntPt
        (if (setq pair (Tangent_Point rad cen intPt))
          (setq tan1 (car pair)
        tan2 (cadr pair)
        ret  (list (PPP_Circle p1 p2 tan1)
           (ppp_circle p1 p2 tan2)
             )
          )
        )
        (setq an     (angle p1 p2)
      HalfPi (/ pi 2)
      tan1   (polar cen (+ an HalfPi) rad)
      tan2   (polar cen (- an HalfPi) rad)
      ret    (list (PPP_Circle p1 p2 tan1)
           (ppp_circle p1 p2 tan2)
             )
        )
      )
    )
  )
)
;;;点切切的圆
(defun PCC_Circle(pt rad1 cen1 rad2 cen2 / hc an p1 p2 d1 d2 dp p3 rt aa)
  (setq HC (car (Homothetic_center rad1 cen1 rad2 cen2)))
  (if HC
    (setq an (angle cen1 cen2)
  p1 (polar cen1 (angle cen1 cen2) rad1)
  p2 (polar cen2 (angle cen2 cen1) rad2)
  d1 (distance hc p1)
  d2 (distance hc p2)
  dp (distance hc pt)
  dq (/ (* d1 d2) dp)
  p3 (polar hc (angle hc pt) dq)
  rt (PPC_Circle pt p3 rad1 cen1)
    )
    (if (equal rad1 rad2 1e-8)
      (progn
        (setq an (angle cen1 cen2)
      aa (angle cen1 pt)
      aa (- aa an)
      dp (distance pt cen1)
      p3 (polar cen2 (- (angle cen2 cen1) aa) dp)
        )
(if (equal p3 pt 1e-8)
  (list (list pt (distance p)))
  (setq rt (PPC_Circle pt p3 rad1 cen1))
)
      )
    )
  )
)

;;;make a point
(defun makepoint (p)
  (entmakex (list '(0 . "POINT") (cons 10 p)))
)

;;;make a circle
(defun makeCircle (p r)
  (entmakex (list '(0 . "CIRCLE") (cons 10 p) (cons 40 r)))
)

;;;make a line
(defun makeline (p q)
  (entmakex (list '(0 . "LINE") (cons 10 p) (cons 11 q)))
)
« Last Edit: September 26, 2011, 07:14:14 AM by HighflyingBird »
Logged
I am a bilingualist,Chinese and Chinglish.

highflyingbird

  • Bull Frog
  • Posts: 415
  • Later equals never.
Re: -={ Challenge }=- 3-Point Circle Tangent to Two Circles, with given Point.
« Reply #6 on: September 26, 2011, 07:18:49 AM »
here is how to draw it. Left is the case of point ,point,circle(PPC), Right is the case of point,circle,circle(PCC),Red circles are the solutions.
« Last Edit: September 26, 2011, 07:22:27 AM by HighflyingBird »
Logged
I am a bilingualist,Chinese and Chinglish.

ribarm

  • Gator
  • Posts: 3249
  • Marko Ribar, architect
Re: -={ Challenge }=- 3-Point Circle Tangent to Two Circles, with given Point.
« Reply #7 on: September 26, 2011, 08:23:32 AM »
Brilliant Highflyingbird...
I've zipped 10 steps from start to the end of construction...

M.R.
Logged
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

Lee Mac

  • Seagull
  • Posts: 12912
  • London, England
Re: -={ Challenge }=- 3-Point Circle Tangent to Two Circles, with given Point.
« Reply #8 on: September 27, 2011, 12:57:11 PM »
I haven't had time to look at this recently, but I shall have to spend some time studying your code Highflyingbird.  :-)
Logged

highflyingbird

  • Bull Frog
  • Posts: 415
  • Later equals never.
Re: -={ Challenge }=- 3-Point Circle Tangent to Two Circles, with given Point.
« Reply #9 on: September 27, 2011, 01:42:52 PM »
here are  the other cases.

then  LCC, and LLC  can be derived from   PLC  question and PLL question.
« Last Edit: September 27, 2011, 01:50:48 PM by HighflyingBird »
Logged
I am a bilingualist,Chinese and Chinglish.

ribarm

  • Gator
  • Posts: 3249
  • Marko Ribar, architect
Re: -={ Challenge }=- 3-Point Circle Tangent to Two Circles, with given Point.
« Reply #10 on: September 28, 2011, 09:19:41 AM »
I've constructed all cases - step by step... Only lack is that I haven't included all tangent circles solutions, but I think and this is fine... So check my *.zip

Regards, M.R.
« Last Edit: September 28, 2011, 05:08:20 PM by ribarm »
Logged
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Gator
  • Posts: 3249
  • Marko Ribar, architect
Re: -={ Challenge }=- 3-Point Circle Tangent to Two Circles, with given Point.
« Reply #11 on: September 28, 2011, 05:13:34 PM »
Just updated *.zip to include CCC (step 04, step 05)... BTW, there is little discord in step 05 circle tan,tan,tan is not exactly matching the construction, but error is minor...

ENJOY, M.R.
Logged
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Gator
  • Posts: 3249
  • Marko Ribar, architect
Re: -={ Challenge }=- 3-Point Circle Tangent to Two Circles, with given Point.
« Reply #12 on: September 29, 2011, 03:37:27 AM »
CCC step 05 is now revised...

M.R.
 8-)
« Last Edit: September 30, 2011, 11:45:58 AM by ribarm »
Logged
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Gator
  • Posts: 3249
  • Marko Ribar, architect
Re: -={ Challenge }=- 3-Point Circle Tangent to Two Circles, with given Point.
« Reply #13 on: September 29, 2011, 06:05:52 PM »
In addition to my last post, I've wrote short routine for drawing radical circle :

Code: [Select]
(defun c:radical-circle ( / SCI1 SCI2 SCI3 C1 C2 C3 CI1 CI2 CI3 D12 D13 D23 N12 N13 N23 O O1 O2 O3 OSM P12 P13 P23 PP12 PP13 PP23 R1 R2 R3 RRAD X12 X13 X23)
(arxload "geomcal.arx")
(vl-cmdf "ucs" "w")
(setq osm (getvar 'osmode))
(setvar 'osmode 0)
(while (null sci1)
(prompt "\nPick first circle")
(setq sci1 (ssget "_+.:E:S" (list (cons 0 "CIRCLE") (cons 210 (list 0.0 0.0 1.0)))))
)
(setq ci1 (ssname sci1 0))
(setq sci2 sci1)
(while (or (null sci2) (equal (ssname sci2 0) ci1))
(prompt "\nPick second circle")
(setq sci2 (ssget "_+.:E:S" (list (cons 0 "CIRCLE") (cons 210 (list 0.0 0.0 1.0)))))
)
(setq ci2 (ssname sci2 0))
(setq sci3 sci2)
(while (or (null sci3) (or (equal (ssname sci3 0) ci1) (equal (ssname sci3 0) ci2)))
(prompt "\nPick third circle")
(setq sci3 (ssget "_+.:E:S" (list (cons 0 "CIRCLE") (cons 210 (list 0.0 0.0 1.0)))))
)
(setq ci3 (ssname sci3 0))
(setq c1 (cdr (assoc 10 (entget ci1))))
(setq c2 (cdr (assoc 10 (entget ci2))))
(setq c3 (cdr (assoc 10 (entget ci3))))
(setq r1 (cdr (assoc 40 (entget ci1))))
(setq r2 (cdr (assoc 40 (entget ci2))))
(setq r3 (cdr (assoc 40 (entget ci3))))
(setq d12 (distance c1 c2))
(setq d13 (distance c1 c3))
(setq d23 (distance c2 c3))
(if (>= r1 r2) (setq x12 (/ (+ d12 (/ (abs (- (expt r1 2) (expt r2 2))) d12)) 2)) (setq x12 (/ (- d12 (/ (abs (- (expt r1 2) (expt r2 2))) d12)) 2)) )
(setq p12 (polar c1 (angle c1 c2) x12))
(setq n12 (cal "nor(c1,c2)"))
(setq pp12 (cal "p12+n12"))
(if (>= r1 r3) (setq x13 (/ (+ d13 (/ (abs (- (expt r1 2) (expt r3 2))) d13)) 2)) (setq x13 (/ (- d13 (/ (abs (- (expt r1 2) (expt r3 2))) d13)) 2)) )
(setq p13 (polar c1 (angle c1 c3) x13))
(setq n13 (cal "nor(c1,c3)"))
(setq pp13 (cal "p13+n13"))
(if (>= r2 r3) (setq x23 (/ (+ d23 (/ (abs (- (expt r2 2) (expt r3 2))) d23)) 2)) (setq x23 (/ (- d23 (/ (abs (- (expt r2 2) (expt r3 2))) d23)) 2)) )
(setq p23 (polar c2 (angle c2 c3) x23))
(setq n23 (cal "nor(c2,c3)"))
(setq pp23 (cal "p23+n23"))
(setq o1 (inters p12 pp12 p13 pp13 nil))
(setq o2 (inters p12 pp12 p23 pp23 nil))
(setq o3 (inters p13 pp13 p23 pp23 nil))
(if (and (equal o1 o2 0.00000001) (equal o2 o3 0.00000001) (equal o1 o3 0.00000001)) (setq o o1))
(setq rrad (sqrt (- (expt (distance c1 o) 2) (expt r1 2))))
(entmakex (list (cons 0 "CIRCLE") (cons 10 o) (cons 40 rrad)))
(setvar 'osmode osm)
(princ)
)

M.R.
« Last Edit: September 30, 2011, 01:07:39 AM by ribarm »
Logged
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 #14 on: September 30, 2011, 10:59:56 AM »
hi , all
Highfly's method  is Efficient , until now , I still can not understand .
Following code is using  Asymptotic method .
Just for test , when the point is close the line (cen1 cen2) , it return the wrong result .
Code: [Select]

(defun c:test (/ foo cir1 cir2 pnt dxf1 dxf2 rad1 rad2 cen1 cen2 cr1)
  (defun foo (mode / is_go pl1 pl2 mp1 mp2)
    ;; Using  Asymptotic method
    ;; mode 1 -- outside 2 circles ; 2 -- include 2 circles
    ;;      3 -- include circle-1  ; 4 -- include circle-2
    ;;
  (if (setq cr1 (3PCirCle pnt cen1 cen2)) (setq is_go T))
  (while is_go
    (setq pl1 (C_INT_C (car cr1) (cadr cr1) cen1 rad1)
  pl2 (C_INT_C (car cr1) (cadr cr1) cen2 rad2)  
  )
     (cond ((and pl1 (cadr pl1))
            (setq mp1 (midpt (car pl1) (cadr pl1)))
   )
  (pl1 (setq mp1 (car pl1)))
  (t)
  )
    (cond ((and pl2 (cadr pl2))
            (setq mp2 (midpt (car pl2) (cadr pl2)))
   )
  (pl1 (setq mp2 (car pl2)))
  (t)
  ) 
    (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 )))
      (setq is_go nil)
      (setq cr1 (3PCirCle pnt (polar cen1 (cond ((or (= mode 1) (= mode 4))(angle cen1 mp1))
((or (= mode 2) (= mode 3)) (if (ss-ostp mp1 pnt cen1 cen2) (angle cen1 mp1) (angle mp1 cen1)))
)
rad1) (polar cen2
      (cond ((or (= mode 1) (= mode 3))(angle cen2 mp2))
((or (= mode 2) (= mode 4)) (if (ss-ostp mp2 pnt cen1 cen2) (angle cen2 mp2) (angle mp2 cen2)))
) rad2)))
      )
    )
  (if cr1 (entmake (list (cons 0 "CIRCLE") (cons 10 (car cr1)) (cons 40 (cadr cr1)) (cons 62 mode))))
    )
  (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))
    (exit)
  )
  (setq dxf1 (entget cir1))
  (setq dxf2 (entget cir2))
  (setq rad1 (cdr (assoc 40 dxf1)))
  (setq rad2 (cdr (assoc 40 dxf2)))
  (setq cen1 (cdr (assoc 10 dxf1)))
  (setq cen2 (cdr (assoc 10 dxf2)))
  ;;
  (foo 1)
  ;;; 
  (foo 2)
  ;;;include circle-1 , outside circle-2
  (foo 3)
  ;;;include circle-2 , outside circle-1
  (foo 4)
  (princ) 
  )
(defun midpt (pta ptb)
  (mapcar (function (lambda (x y)
      (/ (+ x y) 2.0)
    )
  )
  pta
  ptb
  )
)
;;;is outside of triangle
(defun ss-ostp (p p1 p2 p3)
      ;;Gile & Lee Mac
      ((lambda (a b c)
(not
   (or
     (and (< 1e-6 a) (< 1e-6 b) (< 1e-6 c))
     (and (< a -1e-6) (< b -1e-6) (< c -1e-6))
   ) ;_if at triangle edge, so add tolerance
)
       )
(sin (- (angle p1 p) (angle p1 p2)))
(sin (- (angle p2 p) (angle p2 p3)))
(sin (- (angle p3 p) (angle p3 p1)))
      )   
  )
;;;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 (- (* 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 3PCirCle
(P0 P1 P2 / X0 Y0 X1 Y1 X2 Y2 DX1 DY1 DX2 DY2 D 2D C1 C2 CE)
    ;;by highflybird
    (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)))
    (if (/= D 0.0)
      (progn
(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) (list p0 p1 p2))
      )
    )
  )
« Last Edit: September 30, 2011, 11:15:16 AM by chlh_jd »
Logged

chlh_jd

  • Guest
Re: -={ Challenge }=- 3-Point Circle Tangent to Two Circles, with given Point.
« Reply #15 on: September 30, 2011, 11:42:53 AM »
my new version

Code: [Select]
(defun c:t2 (/ foo cir1 cir2 pnt dxf1 dxf2 rad1 rad2 cen1 cen2 cr1)
  (defun foo (mode / is_go pl1 pl2 mp1 mp2 i)
    ;; Using  Asymptotic method
    ;; mode 1 -- outside 2 circles ; 2 -- include 2 circles
    ;;      3 -- include circle-1  ; 4 -- include circle-2
    ;; edited from highflybird's code , by GSLS(SS)
  (if (setq cr1 (3PCirCle pnt cen1 cen2)) (setq is_go T
i 0))
  (while is_go
    (setq pl1 (C_INT_C (car cr1) (cadr cr1) cen1 rad1)
  pl2 (C_INT_C (car cr1) (cadr cr1) cen2 rad2)  
  )
     (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 )))
      (setq is_go nil)
      (cond ((= mode 1)
     (setq cr1 (3PCirCle pnt (mapcar '+ cen1 (pt* (v2u (mapcar '- mp1 cen1)) rad1)) (mapcar '+ cen2 (pt* (v2u (mapcar '- mp2 cen2)) rad2))))
     )
    ((= mode 2)
     (setq cr1 (3PCirCle pnt (mapcar '+ cen1 (pt* (v2u (if (< i 1)(mapcar '- cen1 mp1) (mapcar '- mp1 cen1))) rad1)) (mapcar '+ cen2 (pt* (v2u (if (< i 1) (mapcar '- cen2 mp2) (mapcar '- mp2 cen2))) rad2))))
     )
    ((= mode 3)
     (setq cr1 (3PCirCle pnt (mapcar '+ cen1 (pt* (v2u (if (< i 1)(mapcar '- cen1 mp1) (mapcar '- mp1 cen1))) rad1)) (mapcar '+ cen2 (pt* (v2u (mapcar '- mp2 cen2)) rad2))))
     )
    ((= mode 4)
     (setq cr1 (3PCirCle pnt (mapcar '+ cen1 (pt* (v2u (mapcar '- mp1 cen1)) rad1)) (mapcar '+ cen2 (pt* (v2u (if (< i 1) (mapcar '- cen2 mp2) (mapcar '- mp2 cen2))) rad2))))
     )
    )     
      )
    (setq i (1+ i))
    )
    (princ (strcat "\nmode = " (rtos mode 2 0) "Recursive " (rtos (1+ i) 2 0) "times ."))
  (if cr1 (entmake (list (cons 0 "CIRCLE") (cons 10 (car cr1)) (cons 40 (cadr cr1)) (cons 62 mode))))
    )
  (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 dxf1 (entget cir1))
  (setq dxf2 (entget cir2))
  (setq rad1 (cdr (assoc 40 dxf1)))
  (setq rad2 (cdr (assoc 40 dxf2)))
  (setq cen1 (cdr (assoc 10 dxf1)))
  (setq cen2 (cdr (assoc 10 dxf2)))
  ;;
  (foo 1)
  ;;; 
  (foo 2)
  ;;;include circle-1 , outside circle-2
  (foo 3)
  ;;;include circle-2 , outside circle-1
  (foo 4)
  (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)   
   )
)
;;;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 (- (* 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 3PCirCle
(P0 P1 P2 / X0 Y0 X1 Y1 X2 Y2 DX1 DY1 DX2 DY2 D 2D C1 C2 CE)
    ;;by highflybird
    (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)))
    (if (/= D 0.0)
      (progn
(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) (list p0 p1 p2))
      )
    )
  )

 :-P
« Last Edit: October 01, 2011, 10:16:27 AM by chlh_jd »
Logged

xyp1964

  • Guest
Re: -={ Challenge }=- 3-Point Circle Tangent to Two Circles, with given Point.
« Reply #16 on: September 30, 2011, 09:48:26 PM »
(defun c:tt ()
  (CMDLA0)
  (defun c3p (p0 p1 p2)
    (command "circle" "3p" p0 "tan" p1 "tan" p2)
  )
  (if (and (setq s1 (car (entsel "\nPick circle 1: ")))
      (setq s2 (car (entsel "\nPick circle 2: ")))
      (setq p1 (getpoint "\nPick a point: "))
      )
    (progn (setq s3   (xyp-line p1 (cdr (assoc 10 (entget s1))))
       s4   (xyp-line p1 (cdr (assoc 10 (entget s2))))
       ptn1 (xyp-get-Inters s3 s1 1)
       ptn2 (xyp-get-Inters s4 s2 1)
      )
      (entdel s3)
      (entdel s4)
      (c3p p1 (car ptn1) (car ptn2))
      (c3p p1 (cadr ptn1) (car ptn2))
      (c3p p1 (car ptn1) (cadr ptn2))
      (c3p p1 (cadr ptn1) (cadr ptn2))
    )
  )
  (CMDLA1)
)
Logged

ElpanovEvgeniy

  • Water Moccasin
  • Posts: 1569
  • Moscow (Russia)
Re: -={ Challenge }=- 3-Point Circle Tangent to Two Circles, with given Point.
« Reply #17 on: October 01, 2011, 12:51:51 AM »
Code: [Select]
(defun c:test () (vl-cmdf "_circle" "_3p" "_tan" pause "_tan" pause pause))
Logged

ribarm

  • Gator
  • Posts: 3249
  • Marko Ribar, architect
Re: -={ Challenge }=- 3-Point Circle Tangent to Two Circles, with given Point.
« Reply #18 on: October 01, 2011, 05:21:44 AM »
chlh_jd, you forgot to include subfunction pt* in your new version :

Code: [Select]
;;; pt*
(defun pt* (v d)
  (mapcar (function (lambda (x) (* x d))) v)
)

M.R.
Logged
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 #19 on: October 01, 2011, 08:01:13 AM »
Quote from: ribarm on October 01, 2011, 05:21:44 AM
chlh_jd, you forgot to include subfunction pt* in your new version :

Code: [Select]
;;; pt*
(defun pt* (v d)
  (mapcar (function (lambda (x) (* x d))) v)
)

M.R.
Sorry to forrget it , thank you  ribarm
Logged

Rod

  • Newt
  • Posts: 185
Re: -={ Challenge }=- 3-Point Circle Tangent to Two Circles, with given Point.
« Reply #20 on: October 01, 2011, 08:13:04 PM »
New geometry challenge for those interested
Given two lines (or arcs) join the endpoints (one from each) with two arcs tangential to each other and tangential to the original objects.
This could be an S shape or a compound curve.
I have the answer already if you are interested but not in front of CAD today.

This is similar to the 2012 Blend command but using two arcs instead of a spline.
Eventually I'll write a routine to create this as a polyline and join the original objects

Regards Rod
Logged
"All models are wrong, some models are useful" - George Box

qjchen

  • Bull Frog
  • Posts: 285
  • Best wishes to all
Re: -={ Challenge }=- 3-Point Circle Tangent to Two Circles, with given Point.
« Reply #21 on: October 01, 2011, 09:29:20 PM »
Quote from: Rod on October 01, 2011, 08:13:04 PM
New geometry challenge for those interested
Given two lines (or arcs) join the endpoints (one from each) with two arcs tangential to each other and tangential to the original objects.
This could be an S shape or a compound curve.
I have the answer already if you are interested but not in front of CAD today.

This is similar to the 2012 Blend command but using two arcs instead of a spline.
Eventually I'll write a routine to create this as a polyline and join the original objects

Regards Rod

I think this problem should add one condition, whether this two arcs has the same radius?
Logged
http://qjchen.mjtd.com
My blog http://chenqj.blogspot.com (Chinese, can be translate into English)

Rod

  • Newt
  • Posts: 185
Re: -={ Challenge }=- 3-Point Circle Tangent to Two Circles, with given Point.
« Reply #22 on: October 01, 2011, 10:06:43 PM »
I meant to also say that given a point one of the two arcs must go through the point.
Given any two lines and any point there is always an answer (except when the point lies on the natural fillet one or both of the lines)
« Last Edit: October 03, 2011, 05:53:51 AM by Rod »
Logged
"All models are wrong, some models are useful" - George Box

qjchen

  • Bull Frog
  • Posts: 285
  • Best wishes to all
Re: -={ Challenge }=- 3-Point Circle Tangent to Two Circles, with given Point.
« Reply #23 on: October 02, 2011, 12:43:12 AM »
Quote from: Rod on October 01, 2011, 10:06:43 PM
I meant to also say that given a point one of the two arcs must go through the point.
Given any two lines and any point there is always an answer (except when the point lies on the natural fillet)

This is my solution for 2 lines, and it is also the solution for 2 arcs. It is not so difficult into LISP.
Logged
http://qjchen.mjtd.com
My blog http://chenqj.blogspot.com (Chinese, can be translate into English)

ribarm

  • Gator
  • Posts: 3249
  • Marko Ribar, architect
Re: -={ Challenge }=- 3-Point Circle Tangent to Two Circles, with given Point.
« Reply #24 on: October 02, 2011, 11:57:18 AM »
I've just finished code for all cases of tangent circle. (PPP, LPP, LLP, LLL, CPP, CLP, CLL, CCP, CCL, CCC)
There may be still some wrong results, as it is dependable from situation to situation, but all in all it is mostly acceptable...

Regards, M.R.
« Last Edit: March 21, 2020, 01:16:23 PM by ribarm »
Logged
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 #25 on: October 02, 2011, 01:23:32 PM »
Quote from: ElpanovEvgeniy on October 01, 2011, 12:51:51 AM
Code: [Select]
(defun c:test () (vl-cmdf "_circle" "_3p" "_tan" pause "_tan" pause pause))
I believe this is the best solution  :-)
I someone try to solve the equation :
Code: [Select]
;; (x1,y1) center of circle-1
;; (x2,y2) center of circle-2
;; (x,y) center of result circle
;; (a,b) point given .
;; --->
;; (x-x1)^2+(y-y1)^2=(r±r1)^2
;; (x-x2)^2+(y-y2)^2=(r±r2)^2
;; (x-a)^2+ (y-b)^2=r^2
;; ===>

There's a fun result :
Code: [Select]
(defun thp-t2c (p cen1 r1 cen2 r2 / a b x1 y1 x2 y2 mat cl)
  ;;just for fun
  (setq a  (car p)
b  (car p)
x1 (car cen1)
y1 (cadr cen1)
x2 (car cen2)
y2 (cadr cen2)
cl ((lambda (l)
      (mapcar
(function
  (lambda (x)
    (apply
      (function +)
      (mapcar (function (lambda (e1 e2) (* e1 e2 0.5)))
      l
      x
      )
    )
  )
)
(quote ((1 1 -1 -1 -1 1 0 0)
(-1 -1 1 0 0 0 1 1)
(0 0 0 -1 -1 1 1 1)
       )
)
      )
    )
     (list (* x1 x1)
   (* y1 y1)
   (* r1 r1)
   (* x2 x2)
   (* y2 y2)
   (* r2 r2)
   (* a a)
   (* b b)
     )
   )
  )
  (setq mat (list (list (- x1 x2) (- y1 y2))
  (list (- a x1) (- b y1))
  (list (- a x2) (- b y2))
    )
  )
  (mapcar (function (lambda (x / m)
      (setq m (mapcar (function append)
      mat
      (mapcar (function list)
      (mxv x (list r1 r2))
      )
      )
      )
      (mxv ([inv] m) cl)
    )
  )
  (quote (((1 -1) (-1 0) (0 -1))
   ((1 1) (-1 0) (0 1))
   ((-1 -1) (1 0) (0 -1))
   ((-1 1) (1 0) (0 1))
)
  )
  )
)
Logged

Rod

  • Newt
  • Posts: 185
Re: -={ Challenge }=- 3-Point Circle Tangent to Two Circles, with given Point.
« Reply #26 on: October 03, 2011, 06:03:37 AM »
Most impressed took me a lot longer than you qjchen when this came up at work a while ago. Must admit I did have to go back to my old schoolbooks
Haven't been able to look at the code but will when I get a chance.
Logged
"All models are wrong, some models are useful" - George Box

Rod

  • Newt
  • Posts: 185
Re: -={ Challenge }=- 3-Point Circle Tangent to Two Circles, with given Point.
« Reply #27 on: October 03, 2011, 06:50:08 AM »
Sorry if I hijacked your post Lee

Solutions
For two lines that are not parallel are both pointing towards their point of apparent intersection (see towards offset)
OR
where the are both pointing away from their point of apparent intersection (see away offset)
(shown in white)
The endpoints can be joined using two arcs
(shown in red)
Construct an circle with the centre at the apparent intersection through the NEAREST endpoint
(Shown in yellow)
Construct a second circle using the 3P option through the apparent intersection of the furthermost endpoint and the circle you just created and the two endpoints
(shown in blue)
The tangent between the two arcs in the compound curve will lie on the second circle

For any two lines that are not parallel regardless of whether they are pointing towards their apparent intersection or not
(shown in white) (see in and out)
The endpoints can be joined using two arcs
(shown in red)
Construct an xline using the bisect method from each endpoint
bisect the angle between the extension of the line and the other endpoint
(Shown in yellow)
Construct a circle using the 3P option through the two endpoints and the intersection of the two xlines
(shown in blue)
The tangent between the two arcs in the compound curve will lie on the circle
« Last Edit: October 03, 2011, 06:54:30 AM by Rod »
Logged
"All models are wrong, some models are useful" - George Box

chlh_jd

  • Guest
Re: -={ Challenge }=- 3-Point Circle Tangent to Two Circles, with given Point.
« Reply #28 on: October 03, 2011, 02:29:20 PM »
I post a pitcture that I understand Highflybird suggest method (Not necessary to dump into recursive),but I did not understand the case the point in Circles yet .
Add point at centers-line  case .
New version (recursive yet)
Code: [Select]
(defun c:t2 (/ foo cir1 cir2 pnt ent1 ent2 rad1 rad2 cen1 cen2 cr1 cr0 r1r2)
  ;_(setq gsls_debug "1")
  (defun foo (mode / is_go pl1 pl2 mp1 mp2 i);_(setq mode 2)
    ;; Using  Asymptotic method
    ;; mode 1 -- outside 2 circles ; 2 -- include 2 circles
    ;;      3 -- include circle-1  ; 4 -- include circle-2
    ;; edited from highflybird's code , by GSLS(SS)
    (if (setq cr1 cr0)
      (setq is_go T
    i 0
      )
    )
    (while is_go
      (setq pl1 (C_INT_C (car cr1) (cadr cr1) cen1 rad1)
    pl2 (C_INT_C (car cr1) (cadr cr1) cen2 rad2)
      )
      (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)))    
      )
      ;_for test
      (if(and (= gsls_debug "1") (or (not mp1) (not mp2)))
(progn
     (entmake (list (cons 0 "CIRCLE")
    (cons 10 (car cr1))
    (cons 40 (cadr cr1))
      )
     )
     (princ (strcat "\nError : mode = "
    (rtos mode 2 0)
    " Recursive "
    (rtos (1+ i) 2 0)
    "times  ."
    )
     ))
);_test
      (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)
(cond ((= mode 1)
       (setq cr1
      (3PCirCle pnt
(mapcar '+
cen1
(pt* (v2u (mapcar '- mp1 cen1)) rad1)
)
(mapcar '+
cen2
(pt* (v2u (mapcar '- mp2 cen2)) rad2)
)
      )
       )
      )
      ((= mode 2)
       (setq
cr1 (3PCirCle pnt
       (mapcar '+
       cen1
       (pt* (v2u (if (< i 1)
   (mapcar '- cen1 mp1)
   (mapcar '- mp1 cen1)
)
    )
    rad1
       )
       )
       (mapcar '+
       cen2
       (pt* (v2u (if (< i 1)
   (mapcar '- cen2 mp2)
   (mapcar '- mp2 cen2)
)
    )
    rad2
       )
       )
     )
       )
      )
      ((= mode 3)
       (setq cr1
      (3PCirCle pnt
(mapcar '+
cen1
(pt* (v2u (if (< i 1)
    (mapcar '- cen1 mp1)
    (mapcar '- mp1 cen1)
  )
     )
     rad1
)
)
(mapcar '+
cen2
(pt* (v2u (mapcar '- mp2 cen2)) rad2)
)
      )
       )
      )
      ((= mode 4)
       (setq cr1
      (3PCirCle pnt
(mapcar '+
cen1
(pt* (v2u (mapcar '- mp1 cen1)) rad1)
)
(mapcar '+
cen2
(pt* (v2u (if (< i 1)
    (mapcar '- cen2 mp2)
    (mapcar '- mp2 cen2)
  )
     )
     rad2
)
)
      )
       )
      )
)
      )
      (setq i (1+ i))
    )
    (princ (strcat "\nmode = "
   (rtos mode 2 0)
   "Recursive "
   (rtos i 2 0)
   "times ."
   )
    )
    (if cr1
      (entmake (list (cons 0 "CIRCLE")
     (cons 10 (car cr1))
     (cons 40 (cadr cr1))
     (cons 62 mode)
       )
      )
    )
  )
  (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)
rad1 (cdr (assoc 40 ent1))
rad2 (cdr (assoc 40 ent2))
cen1 (cdr (assoc 10 ent1))
cen2 (cdr (assoc 10 ent2))
r1r2 (distance cen1 cen2) ;_wheelbase
off  (abs (ss-get-d pnt cen1 cen2)) ;_off_axis distance
  )
  (cond
    ((>= r1r2 (+ rad1 rad2))
     (if (or (< (distance pnt cen1) rad1)
     (< (distance pnt cen2) rad2)
)
       (progn (princ "\nError:Point in Circle !") (exit))
       (cond ((<= off 1e-6)
      (setq cr0 (3pcircle pnt
  (polar cen1
(+ (angle cen1 cen2) (/ pi 2))
(/ rad1 2.)
  )
  (polar cen2
(- (angle cen1 cen2) (/ pi 2))
(/ rad2 2.)
  )
)
      )
     )
     (t (setq cr0 (3pcircle pnt cen1 cen2)))
       )
     )
    )
    ((< (abs (- rad1 rad2)) r1r2 (+ rad1 rad2))
     (cond ((<= off 1e-6)
    (setq cr0
   (3pcircle
     pnt
     (polar cen1 (+ (angle cen1 cen2) (/ pi 2)) (/ rad1 2.))
     (polar cen2 (- (angle cen1 cen2) (/ pi 2)) (/ rad2 2.))
   )
    )
   )
   ;|(t (setq cr0 (3pcircle pnt cen1 cen2)))|;
   (t (setq cr0 (3pcircle pnt (polar cen1 (angle cen2 cen1) rad1) (polar cen2 (angle cen1 cen2) rad2))))
     )
    )
    (t
     (cond ((> rad1 rad2)
    (cond ((or (> (distance pnt cen1) rad1)
       (< (distance pnt cen2) rad2)
   )
   (princ "\nError:Point must between the tow Circle !")
   (exit)
  )
  ((<= off 1e-6)
   (setq cr0 (3pcircle pnt
       (polar cen1 (angle cen2 cen1) rad1)
       (polar cen2
      (- (angle cen1 cen2) (/ pi 2))
      (/ rad2 2.)
       )
     )
   )
  )
  (t
   (setq cr0 (3pcircle pnt
       (polar cen1 (angle cen2 cen1) rad1)
       (polar cen2 (angle cen1 cen2) rad2)
     )
   )
  )
    )
   )
   ((< rad1 rad2)
    (cond ((or (> (distance pnt cen2) rad2)
       (< (distance pnt cen1) rad1)
   )
   (princ "\nError:Point must between the tow Circle !")
   (exit)
  )
  ((<= off 1e-6)
   (setq cr0 (3pcircle pnt
       (polar cen2 (angle cen1 cen2) rad2)
       (polar cen1
      (- (angle cen2 cen1) (/ pi 2))
      (/ rad1 2.)
       )
     )
   )
  )
  (t
   (setq cr0 (3pcircle pnt
       (polar cen2 (angle cen1 cen2) rad2)
       (polar cen1 (angle cen2 cen1) rad1)
     )
   )
  )
    )
   )
     )
    )
  )
  ;;
  (foo 1)
;;; 
  (foo 2)
;;;
  (foo 3)
;;;
  (foo 4)
  (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)
  )
)
;;;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 3PCirCle
       (P0 P1 P2 / X0 Y0 X1 Y1 X2 Y2 DX1 DY1 DX2 DY2 D 2D C1 C2 CE)
  ;;by highflybird
  (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)))
  (if (/= D 0.0)
    (progn
      (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) (list p0 p1 p2))
    )
  )
)
(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)))
)
« Last Edit: October 03, 2011, 02:34:03 PM by chlh_jd »
Logged

ribarm

  • Gator
  • Posts: 3249
  • Marko Ribar, architect
Re: -={ Challenge }=- 3-Point Circle Tangent to Two Circles, with given Point.
« Reply #29 on: October 04, 2011, 05:31:39 AM »
Here is yours subfunction in c:ci1xci2 :

Code: [Select]
(defun c:ci1xci2 ( / ssci1 ssci2 ci1 c1 r1 ci2 c2 r2 lst )
  (while (null ssci1)
    (prompt "\nPick first circle")
    (setq ssci1 (ssget "_+.:E:S" (list (cons 0 "CIRCLE") (cons 210 (list 0.0 0.0 1.0)))))
  )
  (while (or (null ssci2) (equal (ssname ssci1 0) (ssname ssci2 0)) )
    (prompt "\nPick second circle")
    (setq ssci2 (ssget "_+.:E:S" (list (cons 0 "CIRCLE") (cons 210 (list 0.0 0.0 1.0)))))
  )
  (setq ci1 (ssname ssci1 0))
  (setq c1 (cdr (assoc 10 (entget ci1))))
  (setq r1 (cdr (assoc 40 (entget ci1))))
  (setq ci2 (ssname ssci2 0))
  (setq c2 (cdr (assoc 10 (entget ci2))))
  (setq r2 (cdr (assoc 40 (entget ci2))))
  (setq lst (C_Int_C c1 r1 c2 r2))
  (princ lst)
(princ)
)

;;;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 (- (* 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
   )
     )
    )
  )
)

And here is mine command function c:ci1xci2 :

Code: [Select]
;; ArcCosine
;; Args: -1 <= x <= 1

(defun acos ( x )
    (cond
        (   (equal x 1.0 1e-8) 0.0)
        (   (equal x -1.0 1e-8) PI)
        (   (atan (sqrt (- 1.0 (* x x))) x))
    )
)

;; ci1xci2

(defun c:ci1xci2 ( / ssci1 ssci2 ci1 c1 r1 ci2 c2 r2 d b h x1 x2 px1 px2 p1 p2 ptl )
  (while (null ssci1)
    (prompt "\nPick first circle")
    (setq ssci1 (ssget "_+.:E:S" (list (cons 0 "CIRCLE") (cons 210 (list 0.0 0.0 1.0)))))
  )
  (while (or (null ssci2) (equal (ssname ssci1 0) (ssname ssci2 0)) )
    (prompt "\nPick second circle")
    (setq ssci2 (ssget "_+.:E:S" (list (cons 0 "CIRCLE") (cons 210 (list 0.0 0.0 1.0)))))
  )
  (setq ci1 (ssname ssci1 0))
  (setq c1 (cdr (assoc 10 (entget ci1))))
  (setq r1 (cdr (assoc 40 (entget ci1))))
  (setq ci2 (ssname ssci2 0))
  (setq c2 (cdr (assoc 10 (entget ci2))))
  (setq r2 (cdr (assoc 40 (entget ci2))))
  (setq d (distance c1 c2))
  (if (and (> d r1) (> d r2))
    (progn
    (setq h (/ (* r1 r2 (sin (acos (/ (+ (* r1 r1) (* r2 r2) (- (* d d))) (* 2 r1 r2))))) d))
    (setq x1 (sqrt (- (* r1 r1) (* h h))))
    (setq x2 (sqrt (- (* r2 r2) (* h h))))
    (setq px1 (polar c1 (angle c1 c2) x1))
    (setq px2 (polar c2 (angle c2 c1) x2))
    (if (equal px1 px2 1e-6) (setq px px1) )
    (setq p1 (polar px (+ (angle c1 c2) (/ PI 2)) h))
    (setq p2 (polar px (- (angle c1 c2) (/ PI 2)) h))
    (if (equal p1 p2 1e-4) (setq ptl (cons p1 ptl)) (progn (setq ptl (cons p2 ptl)) (setq ptl (cons p1 ptl))) )
    )
  )
  (if (and (> r1 r2) (or (<= d r1) (<= d r2)))
    (progn
    (setq b (/ (- (* r1 r1) (* r2 r2) (* d d)) (* 2 d)))
    (setq h (sqrt (- (* r2 r2) (* b b))))
    (setq px (polar c1 (angle c1 c2) (+ b d)))
    (setq p1 (polar px (+ (angle c1 c2) (/ PI 2)) h))
    (setq p2 (polar px (- (angle c1 c2) (/ PI 2)) h))
    (if (equal p1 p2 1e-4) (setq ptl (cons p1 ptl)) (progn (setq ptl (cons p2 ptl)) (setq ptl (cons p1 ptl))) )
    )
  )
  (if (and (> r2 r1) (or (<= d r1) (<= d r2)))
    (progn
    (setq b (/ (- (* r2 r2) (* r1 r1) (* d d)) (* 2 d)))
    (setq h (sqrt (- (* r1 r1) (* b b))))
    (setq px (polar c2 (angle c2 c1) (+ b d)))
    (setq p1 (polar px (+ (angle c1 c2) (/ PI 2)) h))
    (setq p2 (polar px (- (angle c1 c2) (/ PI 2)) h))
    (if (equal p1 p2 1e-4) (setq ptl (cons p1 ptl)) (progn (setq ptl (cons p2 ptl)) (setq ptl (cons p1 ptl))) )
    )
  )
  (if (and (= r1 r2) (= r1 d))
    (progn
    (setq h (* d (/ (sqrt 3) 2)))
    (setq px (polar c1 (angle c1 c2) (/ d 2)))
    (setq p1 (polar px (+ (angle c1 c2) (/ PI 2)) h))
    (setq p2 (polar px (- (angle c1 c2) (/ PI 2)) h))
    (if (equal p1 p2 1e-4) (setq ptl (cons p1 ptl)) (progn (setq ptl (cons p2 ptl)) (setq ptl (cons p1 ptl))) )
    )
  )
  (if (and (= r1 r2) (< d r1))
    (progn
    (setq px (polar c1 (angle c1 c2) (/ (distance c1 c2) 2)))
    (setq h (sqrt (- (* r1 r1) (expt (/ (distance c1 c2) 2) 2))))
    (setq p1 (polar px (+ (angle c1 c2) (/ PI 2)) h))
    (setq p2 (polar px (- (angle c1 c2) (/ PI 2)) h))
    (if (equal p1 p2 1e-4) (setq ptl (cons p1 ptl)) (progn (setq ptl (cons p2 ptl)) (setq ptl (cons p1 ptl))) )
    )
  )
  (if ptl
    (princ ptl)
  )
(princ)
)

Check it for this case :
« Last Edit: October 04, 2011, 06:08:49 AM by ribarm »
Logged
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Gator
  • Posts: 3249
  • 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 »
Logged
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

ribarm

  • Gator
  • Posts: 3249
  • 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)
Logged
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 »
Logged

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 ?
Logged

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 »
Quote from: Ketxu 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 ?
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 .
Quote from: ElpanovEvgeniy on October 01, 2011, 12:51:51 AM
Code: [Select]
(defun c:test () (vl-cmdf "_circle" "_3p" "_tan" pause "_tan" pause pause))
Logged

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 »
Logged

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...



Logged

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 »
Logged
Pages: 1 2 3 [All] |   Go Up
« previous next »