AutoLisp for circle tangent to 2 circles and on a point

[drewsmith007]

I'm using autocad to trace a bunch of freeflowing curves for use in CNC, and I have been using the following command sequence to accomplish what I'm doing. It works fine as it is, but I was wondering if there is a way to automate it. I've tried to learn scripts and autolisp, but can't seem to get them figured out.

Here's the commands:

circle<enter>
3P<enter>
tan<enter>
<select the first circle, already drawn>
tan<enter>
<select the second circle, already drawn>
<pick another third point>

So you end up with a third circle, tangent to the first two, with the circumference passing through the point selected.

Can anyone help?

Thanks.

[marko_ribar]

This one does the job only if third point is osnap independent - uses (grread T)...

(defun c:ci-2cirtan+pt ( / osm StopLoop ci1 ci2 cci1 cci2 ptl sslines ptt lin1 lin2 inters1 inters2 int1d1 int1d2 int2d1 int2d2 pt11 pt12 pt21 pt22 )
(setq osm (getvar 'osmode))
(setvar 'osmode 0)
(setq ci1 (car (entsel "\nPick first circle")))
(setq ci2 (car (entsel "\nPick second circle")))
(setq cci1 (cdr (assoc 10 (entget ci1))))
(setq cci2 (cdr (assoc 10 (entget ci2))))
(prompt "\nRight click for third circle point")
(setq ptl (cons cci1 ptl))
(setq ptl (cons cci1 ptl))
(setq ptl (cons cci2 ptl))
(setq sslines (ssadd))
(while (and (eq (car (grread T (+ 1 4 8) 0)) 5) (not StopLoop))
	(foreach pt ptl
		(if (vl-catch-all-error-p (vl-catch-all-apply 'grdraw (list (cadr (grread T (+ 1 4 8) 0)) pt 256)))
		(progn
			(setq ptt (cadr (grread T (+ 1 4 8) 0)))
			(foreach pt ptl
				(entmakex
					(list
						(cons 0 "LINE")
						(cons 10 pt)
						(cons 11 ptt)
						(cons 62 256)
					)
				)
				(ssadd (entlast) sslines)
			)
			(ssdel (entlast) sslines)
			(entdel (entlast))
			(setq StopLoop T)
		))
	)
	(redraw)
)
(setq lin2 (ssname sslines 0))
(setq lin1 (ssname sslines 1))

;;-----------------=={ Get Intersections }==------------------;;
;;                                                            ;;
;;  Returns a list of all points of intersection between      ;;
;;  two objects                                               ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  obj1, obj2 - VLA-Objects                                  ;;
;;------------------------------------------------------------;;
;;  Returns:  List of intersection points, or nil             ;;
;;------------------------------------------------------------;;

(defun LM:GetIntersections ( obj1 obj2 )
  (LM:GroupByNum (vlax-invoke obj1 'IntersectWith obj2 acExtendBoth) 3)
)

;;-----------------=={ Group by Number }==--------------------;;
;;                                                            ;;
;;  Groups a list into a list of lists, each of length 'n'    ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2010 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Arguments:                                                ;;
;;  l - List to process                                       ;;
;;  n - Number of elements by which to group the list         ;;
;;------------------------------------------------------------;;
;;  Returns:  List of lists, each of length 'n'               ;;
;;------------------------------------------------------------;;

(defun LM:GroupByNum ( l n / r)
  (if l
    (cons
      (reverse (repeat n (setq r (cons (car l) r) l (cdr l)) r))
      (LM:GroupByNum l n)
    )
  )
)

---------------------------------------------------------------

(defun interss ( e1 e2 / inter ) (vl-load-com)
  (if
    (and e1 e2)
    (setq inter (LM:GetIntersections (vlax-ename->vla-object e1) (vlax-ename->vla-object e2)))
  )
  inter
)

---------------------------------------------------------------

(setq inters1 (interss ci1 lin1))
(setq inters2 (interss ci2 lin2))

(setq int1d1 (distance (car inters1) ptt))
(setq int1d2 (distance (cadr inters1) ptt))
(setq int2d1 (distance (car inters2) ptt))
(setq int2d2 (distance (cadr inters2) ptt))

(if (< int1d1 int1d2) (progn (setq pt11 (car inters1)) (setq pt12 (cadr inters1)) ) (progn (setq pt12 (car inters1)) (setq pt11 (cadr inters1)) ) )
(if (< int2d1 int2d2) (progn (setq pt21 (car inters2)) (setq pt22 (cadr inters2)) ) (progn (setq pt22 (car inters2)) (setq pt21 (cadr inters2)) ) )

(vl-cmdf "_.erase" sslines "")
(vl-cmdf "_.circle" "3p" "_tan" pt11 "_tan" pt21 "_non" ptt)
(vl-cmdf "_.circle" "3p" "_tan" pt11 "_tan" pt22 "_non" ptt)
(vl-cmdf "_.circle" "3p" "_tan" pt12 "_tan" pt22 "_non" ptt)
(vl-cmdf "_.circle" "3p" "_tan" pt12 "_tan" pt21 "_non" ptt)
 
(setvar 'osmode osm)

(princ)
)

M.R.

[Lee Mac]

This should work, but I'm striving to obtain a geometric solution:

(defun c:test ( / _selectcircle c1 c2 p1 )

    (defun _selectcircle ( msg / e )
        (while
            (progn (setvar 'ERRNO 0) (setq e (entsel msg))
                (cond
                    (   (= 7 (getvar 'ERRNO))
                        (princ "\nMissed, try again.")
                    )
                    (   (eq 'ENAME (type (car e)))
                        (if (not (eq "CIRCLE" (cdr (assoc 0 (entget (car e))))))
                            (princ "\nPlease Select a Circle.")
                        )
                    )
                )
            )
        )
        e
    )

    (if
        (and
            (setq c1 (_selectcircle "\nSelect 1st Circle: "))
            (setq c2 (_selectcircle "\nSelect 2nd Circle: "))
            (setq p1 (getpoint "\nSpecify Point: "))
        )
        (command "_.circle" "_3P" "_tan" (cadr c1) "_tan" (cadr c2) "_non" p1)
    )
    (princ)
)

[marko_ribar]

I believe you're wright Lee - 4 possible solutions... I revised my code...

As for a construction, even for this first circle - closest 2 tangents I don't find it simple. All I constructed is triangle around solution circle so that edges represent its tangents... So, maybe if we can construct that triangle, then solution is symmetries of triangle angles...

M.R.

[drewsmith007]

Thanks guys, that works great. It seems to matter which part of the circles you select as to which tangent is drawn, but that's no big deal. You just saved me hours of work. I really need to learn to code these things.

Thanks again!

[Lee Mac]

It seems to matter which part of the circles you select as to which tangent is drawn...

Since you are providing a point with the specification that the circle is tangent to two other circles, there is no restriction on the radius and so I believe there are in fact 4 solutions to this problem, e.g.:



If instead you were to provide the radius, the problem would be reduced to two results and a geometric solution would be much easier to obtain:

(defun c:test ( / p1 p2 r1 r2 r3 )
  (if
    (and
      (setq p1 (getpoint "\nCentre of First Circle: "))
      (setq r1 (getdist  "\nRadius of First Circle: " p1))
      (setq p2 (getpoint "\nCentre of Second Circle: "))
      (setq r2 (getdist  "\nRadius of Second Circle: " p2))
      (setq r3 (getdist  "\nRadius of Tangent Circle: "))
    )
    (foreach x (TTRCircle (trans p1 1 0) r1 (trans p2 1 0) r2 r3)
      (entmakex
        (list (cons 0 "CIRCLE") (cons 10 x) (cons 40 r3))
      )
    )
  )
  (princ)
)

(defun TTRCircle ( c1 r1 c2 r2 r3 / d1 n1 x1 z1 )
  (cond
    ( (< (+ r3 r3) (- (setq d1 (distance c1 c2)) (+ r1 r2)))
      nil
    )
    ( t
      (setq n1 (mapcar '- c2 c1)
            z1 (/ (- (+ (expt (+ r3 r1) 2) (expt d1 2)) (expt (+ r3 r2) 2)) (* 2. d1))
            x1 (sqrt (- (expt (+ r3 r1) 2) (expt z1 2)))
            c1 (trans c1 0 n1)
      )
      (list
        (trans (list (+ (car c1) x1) (cadr c1) (+ (caddr c1) z1)) n1 0)
        (trans (list (- (car c1) x1) (cadr c1) (+ (caddr c1) z1)) n1 0)
      )
    )
  )
)

[ibach_]

Hi Lee! As i said to you today... I'm a bit bored at work... was looking at some circle-tangent code and found some of your posts and lisps.

This one is interesting but has some strange behavior that is a bit hard to explain in writing.
I'm attaching DWG with problem I've had with that lisp. May bee you will see what's wrong.
I have written text in the file to explain what i mean.

I was only looking for the points selected directly on a circle, not any point in 2d space, for a last selection.
For some points that I'm sure that have a solution, I could not get any.
For some points there are 2 solutions and i get 1 or none...

Could not find error in the code.
These being boundary input points this could have something to do with error... snap could have something to do with it.

And this again would lead to solution of autocads poor tangent snap ... frequently not being exactly on the circle,
preventing joining the polylines sometimes in the work to follow.

Have a look!

Ps
I was refering to the (defun c:test ( / _selectcircle c1 c2 p1 ) lisp, not the (defun c:test ( / p1 p2 r1 r2 r3 )