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