Visual LISP, AutoLISP and General Customization
cancel
Showing results for 
Show  only  | Search instead for 
Did you mean: 

circel tangent

2 REPLIES 2
Reply
Message 1 of 3
sudarsann
831 Views, 2 Replies

circel tangent

I prepared a small routene for creating a circle, a horizantal line, vertical line as shown in drawing in white color in attachment.
I need to add code for below given lisp routene to draw a circle using 3p method ( tangent, tangent, endpoint ) shown in red color.
Can anyone suggest me the lisp routene.

Regards
Sudarsan

 

My code:


(Defun c:t2s()
(setq O (list 0 0)); fixed
(setq O2 (list 0 1000));fixed
(command "line" o o2 "")
(setq obj_line (entlast))
(setq E (list -30 0));fixed
(setq C (list 0 100));variable
(setq D (list -500 100));(list (- (+ (car C) cd)) C_Y));variable
(setq F (list -45 170))
(setq L (list 0 L_Y))
(setq M (list 0 500)
N (list -100 500)
);setq
(command "circle" "3P" E D F)
(setq obj_circle (entlast))
(command "line" M N "")
(setq obj_line2 (entlast))
);defun

2 REPLIES 2
Message 2 of 3
gpcattaneo
in reply to: sudarsann

(command "circle" "3P" "tan" D "tan" O2 N)

Message 3 of 3
Lee_Mac
in reply to: sudarsann

This looks to be the Apollonius PLC (Point-Line-Circle) problem, for which there are generally 4 possible solutions.

 

Try the following code:

 

(defun c:t2s ( / c )
    (entmake '((0 . "LINE") (10 0   0) (11    0 1000)))
    (entmake '((0 . "LINE") (10 0 500) (11 -100  500)))
    (if
        (and
            (setq c (LM:3pcircle '(-30 0) '(-500 100) '(-45 170)))
            (entmake (list '(0 . "CIRCLE") (cons 10 (car c)) (cons 40 (cadr c))))
        )
        (foreach c (LM:apollonius-plc '(-100 500) '(0 0) '(0 1000) (car c) (cadr c))
            (entmake (list '(0 . "CIRCLE") (cons 10 (car c)) (cons 40 (cadr c)) '(62 . 1)))
        )
    )
    (princ)
)

;; Apollonius-PLC (Point-Line-Circle)  -  Lee Mac
;; Returns the center & radii of the 4 circles representing the solution to the Apollonius-PLC problem.
;; Compatible in WCS only.

(defun LM:apollonius-plc ( pnt pt1 pt2 cen rad / ang ept cpt rtn tmp )
    (setq ang (+ (angle pt1 pt2) (/ pi 2.0)))
    (repeat 2
        (if (and (setq ept (polar  cen ang rad))
                 (setq tmp (inters pt1 pt2 cen ept nil))
                 (setq tmp (LM:3pcircle pnt (polar cen (+ ang pi) rad) tmp))
                 (setq cpt (apply 'LM:interslinecircle (vl-list* ept pnt tmp)))
            )
            (setq rtn (append rtn (LM:apollonius-ppc (car cpt) (cadr cpt) cen (abs rad))))
        )
        (setq rad (- rad))
    )
    rtn
)

;; Apollonius-PPC (Point-Point-Circle)  -  Lee Mac
;; Returns the center & radii of the 2 circles representing the solution to the Apollonius-PPC problem.
;; Compatible in WCS only.

(defun LM:apollonius-ppc ( pt1 pt2 cen rad / cir int lst md1 md2 )
    (if (and (setq cir (LM:3pcircle pt1 pt2 cen))
             (setq lst (LM:inters2circle cen rad (car  cir) (cadr cir))
                   int (inters pt1 pt2 (car lst) (cadr lst) nil)
             )
             (setq md1 (mid pt1 pt2)
                   md2 (mapcar '+ md1 ((lambda ( v ) (list (- (cadr v)) (car v))) (mapcar '- pt2 pt1)))
             )
        )
        (vl-remove 'nil
            (mapcar
               '(lambda ( tan / tmp )
                    (if (setq tmp (inters md1 md2 cen tan nil))
                        (list tmp (distance tmp pt1))
                    )
                )
                (LM:pointcircletangents int cen rad)
            )
        )
    )
)

;; 3-Point Circle (Cartesian)  -  Lee Mac
;; Returns the center and radius of the circle defined by the supplied three points.

(defun LM:3pcircle ( p1 p2 p3 / a b c d )
    (setq p2 (mapcar '- p2 p1)
          p3 (mapcar '- p3 p1)
          a  (* 2.0 (- (* (car p2) (cadr p3)) (* (cadr p2) (car p3))))
          b  (distance '(0.0 0.0) p2)
          c  (distance '(0.0 0.0) p3)
          b  (* b b)
          c  (* c c)
    )
    (if (not (equal 0.0 a 1e-8))
        (list
            (setq d
                (mapcar '+ p1
                    (list
                        (/ (- (* (cadr p3) b) (* (cadr p2) c)) a)
                        (/ (- (* (car  p2) c) (* (car  p3) b)) a)
                        0.0
                    )
                )
            )
            (distance d p1)
        )
    )
)

;; 2-Circle Intersection  -  Lee Mac
;; Returns the point(s) of intersection between two circles
;; with centres c1,c2 and radii r1,r2

(defun LM:inters2circle ( c1 r1 c2 r2 / n d1 x z )
    (if (and (< (setq d1 (distance c1 c2)) (+ r1 r2))
             (< (abs (- r1 r2)) d1)
        )
        (progn
            (setq n  (mapcar '- c2 c1)
                  c1 (trans c1 1 n)
                  z  (/ (- (+ (* r1 r1) (* d1 d1)) (* r2 r2)) (+ d1 d1))
            )
            (if (equal z r1 1e-8)
                (list (trans (list (car c1) (cadr c1) (+ (caddr c1) z)) n 1))
                (progn
                    (setq x (sqrt (- (* r1 r1) (* z z))))
                    (list
                        (trans (list (- (car c1) x) (cadr c1) (+ (caddr c1) z)) n 1)
                        (trans (list (+ (car c1) x) (cadr c1) (+ (caddr c1) z)) n 1)
                    )
                )
            )
        )
    )
)

;; Line-Circle Intersection  -  Lee Mac
;; Returns the point(s) of intersection between an infinite line defined by
;; points p,q and circle with centre c and radius r

(defun LM:interslinecircle ( p q c r / a d n s )
    (setq n (mapcar '- q p)
          p (trans p 0 n)
          c (trans c 0 n)
          a (list (car p) (cadr p) (caddr c))
    )
    (cond
        (   (equal r (setq d (distance c a)))
            (list (trans a n 0))
        )
        (   (< d r)
            (setq s (sqrt (- (* r r) (* d d))))
            (list
                (trans (list (car p) (cadr p) (- (caddr c) s)) n 0)
                (trans (list (car p) (cadr p) (+ (caddr c) s)) n 0)
            )
        )
    )
)

;; Point-Circle Tangents  -  Lee Mac
;; Returns the two points for which a line from 'pt' to each point returned
;; is tangent to the circle with centre c1 and radius r1

(defun LM:pointcircletangents ( pt c1 r1 / a1 a2 d1 )
    (if (< r1 (setq d1 (distance pt c1)))
        (progn
            (setq a2 (atan (sqrt (- (* d1 d1) (* r1 r1))) r1))
            (list
                (polar c1 (+ (angle c1 pt) a2) r1)
                (polar c1 (- (angle c1 pt) a2) r1)
            )
        )
    )
)

;; Midpoint  -  Lee Mac
;; Returns the midpoint of two points

(defun mid ( a b )
    (mapcar (function (lambda ( a b ) (/ (+ a b) 2.0))) a b)
)

(princ)

 

Can't find what you're looking for? Ask the community or share your knowledge.

Post to forums  

Forma Design Contest


Autodesk Design & Make Report