绘制两个圆的公切线

langjs · 发表于 2025-10-30 21:46:56

本帖最后由 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)
)

pzweng · 发表于 2025-10-31 08:09:31

这个是我常用的
(defun c:tl nil
  (setvar 'cmdecho 0)
  (command "line" "tangent" pause "tangent" pause "")
  (princ)
)

不一样地设计 · 发表于 2025-10-30 22:42:17

感谢分享。

yyz123121 · 发表于 2025-10-30 22:57:20

感谢分享，化繁为简！

sowin · 发表于 2025-10-31 08:11:50

谢谢分享。

whc880328 · 发表于 2025-10-31 12:47:30

感谢楼主无私分享

wosiguwozai0830 · 发表于 2025-10-31 13:57:59

pzweng 发表于 2025-10-31 08:09
这个是我常用的
(defun c:tl nil
(setvar 'cmdecho 0)

试用了，看着代码少，但功能挺强的

langjs · 发表于 2025-10-31 14:50:15

pzweng 发表于 2025-10-31 08:09
这个是我常用的
(defun c:tl nil
(setvar 'cmdecho 0)

你这个比我的好用

qazxswk · 发表于 2025-10-31 15:30:28

pzweng 发表于 2025-10-31 08:09
这个是我常用的
(defun c:tl nil
(setvar 'cmdecho 0)

这叫精辟

ynhh · 发表于 2025-11-1 17:16:01

pzweng 发表于 2025-10-31 08:09
这个是我常用的
(defun c:tl nil
(setvar 'cmdecho 0)

这写法很少见
学习了
谢谢

账号		自动登录	找回密码
密码			注册

[源码] 绘制两个圆的公切线

评分