你这段的加圆不能圈在文字外框
我取的是文字高度，不是宽度，呵呵，用来给序号加圆圈而已，你想文字外框，就是要文字宽度 meja 发表于 2023-6-18 13:16
院长，你这代码十年前就编好了吧，我是来请教改代码的
(defun c:tt ()
(setq i 0)
(if (setq ss (ssget '((0 . "text"))))
(repeat (sslength ss)
(setq s1 (ssname ss i)
i (1+ i)
ptn (textbox (entget s1))
p10 (cdr (assoc 10 (entget s1)))
p1 (car ptn)
p2 (cadr ptn)
p1 (mapcar '(lambda (x y) (+ x y)) p1 p10)
p2 (mapcar '(lambda (x y) (+ x y)) p2 p10)
pc (mapcar '(lambda (x y) (* (+ x y) 0.5)) p1 p2)
rr (* (distance p1 p2) 0.5)
)
(command "circle" "non" pc rr)
)
)
(princ)
)
本帖最后由 meja 于 2023-6-20 16:05 编辑
xyp1964 发表于 2023-6-20 00:02
对你的佩服犹如滔滔江水:D-有本事追加一个对大部分图元（线 弧 字 块）加圆的;P meja 发表于 2023-6-20 08:33
对你的佩服犹如滔滔江水有本事追加一个对大部分图元（线 弧 字 块）加圆的
(defun c:tt ()
(setq i 0)
(if (setq ss (ssget))
(repeat (sslength ss)
(setq s1 (ssname ss i)
i (1+ i)
ptn (xyp-9ptLIst s1)
pc (nth 4 ptn)
rr (* (distance (car ptn) (last ptn)) 0.5)
)
(command "circle" "non" pc rr)
)
)
(princ)
)
页:
1
[2]