; =======================================================
; AUTOLISP 实用程序
; 2012 年 01月
; 作 者：王颖
;
; 本程式仅供非商业的使用，严格禁止未经作者同意的贩售或租借。
; 并且本版权宣告不可删除。
; =======================================================
;;;切切切绘圆
(defun C:TTT (/ os ap e1 en1 ena pa vs Ls p1 p2 p3 p4
e2 en2 enb pb e3 en3 pc e4 B e5 nu)
(setq m:err *error* *error* *merr*)
(setvar "cmdecho" 0)
(command "UNDO" "G")
(setq os (getvar "osmode"))
(setvar "osmode" 0)
(setq ap (getvar "aperture"))
(setvar "aperture" 10)
(while (= e1 nil)
(setq e1 (entsel "\n选取第一个相切图元:"))
) ;while
(setq en1 (cdr (assoc '0 (entget (car e1)))))
(while (= en1 "SPLINE")
(princ "\n不可选取样条曲线!")
(setq e1 (entsel "\n选取第一个相切图元:"))
(while (not e1)
(setq e1 (entsel "\n选取第一个相切图元:"))
) ;while
(setq en1 (cdr (assoc '0 (entget (car e1)))))
) ;;while
(setq ena (car e1))
(redraw ena 3)
(setq pa (cadr e1))
(setq pa (osnap pa "nearest"))
(setq vs (getvar "viewsize"))
(setq Ls (/ vs 32))
(setq p1 (polar pa (* pi 0.25) Ls))
(setq p2 (polar pa (* pi 1.25) Ls))
(setq p3 (polar pa (* pi 0.75) Ls))
(setq p4 (polar pa (* pi 1.75) Ls))
(grvecs (list 2 p1 p2 2 p3 p4))
(while (= e2 nil)
(setq e2 (entsel "\n选取第二个相切图元:"))
) ;while
(setq en2 (cdr (assoc '0 (entget (car e2)))))
(while (= en2 "SPLINE")
(princ "\n不可选取样条曲线!")
(setq e2 (entsel "\n选取第二个相切图元:"))
(while (not e2)
(setq e2 (entsel "\n选取第二个相切图元:"))
) ;while
(setq en2 (cdr (assoc '0 (entget (car e2)))))
) ;;while
(setq enb (car e2))
(redraw enb 3)
(setq pb (cadr e2))
(setq pb (osnap pb "nearest"))
(setq p1 (polar pb (* pi 0.25) Ls))
(setq p2 (polar pb (* pi 1.25) Ls))
(setq p3 (polar pb (* pi 0.75) Ls))
(setq p4 (polar pb (* pi 1.75) Ls))
(grvecs (list 2 p1 p2 2 p3 p4))
(while (= e3 nil)
(setq e3 (entsel "\n选取第三个相切图元:"))
) ;while
(setq en3 (cdr (assoc '0 (entget (car e3)))))
(while (= en3 "SPLINE")
(princ "\n不可选取样条曲线!")
(setq e3 (entsel "\n选取第三个相切图元:"))
(while (not e3)
(setq e3 (entsel "\n选取第三个相切图元:"))
) ;while
(setq en3 (cdr (assoc '0 (entget (car e3)))))
) ;;while
(setq pc (cadr e3))
(setq pc (osnap pc "nearest"))
(redraw)
(setq e4 (entlast))
(if (= e4 nil)(setq e4 e3))
(setq B (ssadd))
(ssadd e4 B)
(redraw ena 4)
(redraw enb 4)
(command "circle" "3p" "tan" pa "tan" pb "tan" pc)
(setq e5 (entlast))
(if (= e5 nil)(setq e5 e3))
(ssadd e5 B)
(setq nu (sslength B))
(if (> nu 1)
(princ "\n三切圆绘制完成!")
(princ "\n无法生成三切圆!"))
(setvar "aperture" ap)
(setvar "osmode" os)
(command "UNDO" "E")
(princ))


试下
行不行啊
大哥顶你啦