求助关于子函数改造

669423907

请教一下，如何把circle4改为子函数？
主要作用在于自动找圆离光标点最近的象限点


(defun c:13()
(setq p1 (getpoint"\n请指定基点标注第一点:"))


(if (setq ss (ssget p1 '((0 . "circle,arc"))) )
(progn
(setq i p1)
(circle4 ss)
(setq p1 i)
) )


(command "dimlinear" "non" p1 "\\""\\")
(while
(setq p2 (getpoint p1"\n请指定基点标注下一点:"))


(if (setq ss (ssget p2 '((0 . "circle,arc"))) )
(progn
(setq i p2)
(circle4 ss)
(setq p2 i)
) )
(command "dimlinear" "non" p1 "non" p2 "\\") )
(while (= 1 (getvar "cmdactive"))(command"\\"))
(timea);(c:001) ;0层前置
(princ))


(defun circle4(ss / c r) ;获取圆或圆弧四象限点
(setq ss (entget (ssname (ssget":e:s") 0)))
(setq c (cdr (assoc 10 ss)) ;圆心
r    (cdr (assoc 40 ss)) ;半径
o1 (mapcar '- c (list r 0)) ;左
o2 (mapcar '+ c (list 0 r)) ;上
o3 (mapcar '+ c (list r 0)) ;右
o4 (mapcar '- c (list 0 r)) ;下
)
(if (<= (distance i o1) (* r 0.3)) (setq i o1))
(if (<= (distance i o2) (* r 0.3)) (setq i o2))
(if (<= (distance i o3) (* r 0.3)) (setq i o3))
(if (<= (distance i o4) (* r 0.3)) (setq i o4))
(princ))

自贡黄明儒

(osnap p "qua")

669423907

自贡黄明儒 发表于 2019-7-25 18:29
(osnap p "qua")

有条件限制的，≤0.3r