绘制两个圆的公切线
本帖最后由 langjs 于 2025-11-2 04:06 编辑手动画两个圆的公切线步骤繁多，因此编了个小程序，只需选择两个圆或者圆弧即可，可画内公切线和外公切线
;; ============================================
;;; 名称: 《公切线》
;;; 功能：绘制两个圆的公切线
;;; 命令：gqx 作者：langjs
;;; ============================================
(defun c:aa (/ #err $orr ang code color d ent1 ent2 gr k loop name1 nearpt osmo p1 p10 p11 p12 p13 p2 p3 p4 p5 p6 p7 p8 pt pt1 pt2
pt3 pt4 r r1 r2 ss x
)
(defun asin (x) ; 反正弦
(if (<= (abs x) 1)
(atan x (sqrt (- 1 (* x x))))
)
)
(defun acos (x) ; 反余弦
(if (<= (abs x) 1)
(atan (sqrt (- 1 (* x x))) x)
)
)
(defun #err (s)
(redraw)
(setq *error* $orr)
)
(setvar "CMDECHO" 0)
(setq $orr *error*)
(setq *error* #err)
(princ "\n《公切线》")
(if (and
(setq name1 (entsel "\n选择圆或圆弧:"))
(setq pt1 (cadr name1))
(setq pt1 (osnap pt1 "_NEA"))
(setq name1 (car name1))
(setq ent1 (entget name1))
(setq pt3 (cdr (assoc 10 ent1)))
(setq r1 (cdr (assoc 40 ent1)))
(setq ang (angle pt3 pt1))
(member (cdr (assoc 0 ent1)) '("CIRCLE" "ARC"))
)
(progn
(princ "\n选择第二个圆或圆弧:")
(setq loop t)
(while loop
(setq gr (grread t 15 0)
code (car gr)
pt (cadr gr)
)
(cond
((= code 3) ; 鼠标左键
(redraw)
(setq loop nil)
(if (and
(setq pt2 (osnap pt "_NEA")) ; 接近
(setq ss (ssget "C" pt2 pt2 '((0 . "CIRCLE,ARC"))))
)
(progn
(setq ent2 (entget (ssname ss 0))
pt4 (cdr (assoc 10 ent2))
r2 (cdr (assoc 40 ent2))
r (angle pt4 pt3)
d (distance pt3 pt4)
)
(if (inters
pt1
pt2
pt3
pt4
)
(setq p7 (polar pt4 (- r (- (* 0.5 pi) (asin (/ (+ r1 r2) d)))) r2)
p8 (polar pt4 (+ r (- (* 0.5 pi) (asin (/ (+ r1 r2) d)))) r2)
p5 (polar pt3 (- r (- (* 0.5 pi) (asin (/ (+ r1 r2) d))) pi) r1)
p6 (polar pt3 (+ r (- (* 0.5 pi) (asin (/ (+ r1 r2) d))) pi) r1)
)
(setq p7 (polar pt4 (- r (- (* 0.5 pi) (asin (/ (- r2 r1) d)))) r2)
p8 (polar pt4 (+ r (- (* 0.5 pi) (asin (/ (- r2 r1) d)))) r2)
p5 (polar pt3 (- r (- (* 0.5 pi) (asin (/ (- r2 r1) d)))) r1)
p6 (polar pt3 (+ r (- (* 0.5 pi) (asin (/ (- r2 r1) d)))) r1)
)
)
(if (< (distance pt1 p5) (distance pt1 p6))
(entmake (list '(0 . "LINE") (cons 10 p5) (cons 11 p7)))
(entmake (list '(0 . "LINE") (cons 10 p6) (cons 11 p8)))
)
)
)
)
((= code 5) ; 鼠标移动
(setq color (vla-get-autosnapmarkercolor (vla-get-drafting (vla-get-preferences (vlax-get-acad-object))))
k (* 1.2 (/ (getvar "viewsize") (cadr (getvar "screensize"))) (getvar "pickbox"))
)
(if (> (distance pt3 pt) r1)
(if (< ang pi)
(if (< ang (angle pt3 pt) (+ ang pi))
(setq pt1 (polar pt3 (- (angle pt3 pt) (acos (/ r1 (distance pt3 pt)))) r1))
(setq pt1 (polar pt3 (+ (angle pt3 pt) (acos (/ r1 (distance pt3 pt)))) r1))
)
(if (< (- ang pi) (angle pt3 pt) ang)
(setq pt1 (polar pt3 (+ (angle pt3 pt) (acos (/ r1 (distance pt3 pt)))) r1))
(setq pt1 (polar pt3 (- (angle pt3 pt) (acos (/ r1 (distance pt3 pt)))) r1))
)
)
(setq pt1 pt)
)
(redraw)
(setvar "lastpoint" pt1)
(if (and
(setq nearpt (osnap pt "_TAN")) ; 切点
(equal nearpt pt k)
)
(progn
(setq pt2 nearpt
p3 (list (+ (car pt2) k) (+ (cadr pt2) k))
p4 (list (- (car pt2) k) (+ (cadr pt2) k))
p5 (list (car pt2) (+ (cadr pt2) k))
p6 (list (car pt2) (- (cadr pt2) k))
p7 (list (- (car pt2) k) (cadr pt2))
p8 (list (+ (car pt2) k) (cadr pt2))
p10 (list (- (car pt2) (* 0.7 k)) (+ (cadr pt2) (* 0.7 k)))
p11 (list (- (car pt2) (* 0.7 k)) (- (cadr pt2) (* 0.7 k)))
p12 (list (+ (car pt2) (* 0.7 k)) (- (cadr pt2) (* 0.7 k)))
p13 (list (+ (car pt2) (* 0.7 k)) (+ (cadr pt2) (* 0.7 k)))
)
(grvecs (list color p5 p10 p10 p7 p7 p11 p11 p6 p6 p12 p12 p8 p8 p13 p13 p5 p3 p4))
)
(if (and
(setq nearpt (osnap pt "_NEA")) ; 接近
(ssget "C" nearpt nearpt '((0 . "CIRCLE,ARC")))
)
(progn
(setq pt2 nearpt
p1 (list (- (car pt2) k) (- (cadr pt2) k))
p2 (list (+ (car pt2) k) (- (cadr pt2) k))
p3 (list (+ (car pt2) k) (+ (cadr pt2) k))
p4 (list (- (car pt2) k) (+ (cadr pt2) k))
)
(grvecs (list color p1 p2 p2 p4 p3 p4 p3 p1))
)
(setq pt2 pt
osmo nil
)
)
)
(grvecs (list 4 pt1 pt2))
)
((member code '(11 25)) ; 鼠标右击
(redraw)
(setq loop nil)
)
)
)
)
)
(setq *error* $orr)
(princ)
)
这个是我常用的
(defun c:tl nil
(setvar 'cmdecho 0)
(command "line" "tangent" pause "tangent" pause "")
(princ)
) 感谢分享。 感谢分享，化繁为简！ 谢谢分享。 感谢楼主无私分享 pzweng 发表于 2025-10-31 08:09
这个是我常用的
(defun c:tl nil
(setvar 'cmdecho 0)
试用了，看着代码少，但功能挺强的 pzweng 发表于 2025-10-31 08:09
这个是我常用的
(defun c:tl nil
(setvar 'cmdecho 0)
你这个比我的好用 pzweng 发表于 2025-10-31 08:09
这个是我常用的
(defun c:tl nil
(setvar 'cmdecho 0)
这叫精辟:lol pzweng 发表于 2025-10-31 08:09
这个是我常用的
(defun c:tl nil
(setvar 'cmdecho 0)
这写法很少见
学习了
谢谢
页:
[1]
2