文字实际最小包围框，自己理解最适用，绕弯反而简单
本帖最后由 wzg356 于 2023-9-27 07:47 编辑;==============
;文字实际最小包围框 by wzg356
;(command "pline" (foreach p (txtbox (car(entsel)))(command "non" p)))
(defun txtbox(e / Rot2D es a l l1 w w1 z eb p1 p2)
(defun Rot2D (v a / c s x y)
(setq c (cos a) s (sin a) x (car v) y (cadr v))
(list (- (* x c) (* y s)) (+ (* x s) (* y c)))
);;; 旋转向量到指定角度 by高飞鸟
(setq es(if(listp e)e(entget e)))
(setq a(cdr(assoc 50 es)))
(if(= (cdr(assoc 0 es))"MTEXT")
(setq l(cdr(assoc 42 es)) w(cdr(assoc 43 es))z(cdr(assoc 71 es))
w1(if(member z '(4 5 6))(* 0.5 w)(if(member z '(7 8 9))0 w))
l1(if(member z '(2 5 8))(* 0.5 l)(if(member z '(1 4 7))0 l))
p1(polar (polar (Rot2D(cdr(assoc 10 es))(- 0 a)) pi l1) (* 1.5 pi) w1)
)
(setq eb(textbox es) p1(car eb)
l(distance p1(list(caadr eb)(cadr p1)))
w(distance p1(list(car p1)(cadadr eb)))
p1(mapcar '+ p1(Rot2D(cdr(assoc 10 es))(- 0 a)))
)
)
(setq p1(Rot2D p1 a) p2(polar p1 a l) a(+ a(* 0.5 pi)))
(list p1 p2 (polar p2 a w)(polar p1 a w))
)
你很伟大 分享了那么多好的代码 谢谢楼主分享，学习一下 应用例子
文字下划线标注
(defun c:xhx( / e es ps p1 p2 h r)
(princ "\n选择文本：")
(and(setq e (ssget ":E:S" '((0 . "*TEXT"))))
(setq e (ssname e 0) es(entget e))
(setq ps(txtbox e))
(setq h(cdr(assoc 40 es)) r(angle(last ps)(car ps)))
(setq p1(polar (car ps) r (* h 0.2)) p2(polar (cadr ps) r (* h 0.2)))
(command".pline""non"p1 "w" (* h 0.08) (* h 0.08)"non" p2 "")
)
) wzg356 发表于 2021-4-9 22:48
应用例子
文字下划线标注
(defun c:xhx( / e es ps p1 p2 h r)
还有一个应用场景 文字加框（包括加方框和圆框）可以开发一下代码吗 依然小小鸟 发表于 2021-4-10 09:30
还有一个应用场景 文字加框（包括加方框和圆框）可以开发一下代码吗
对你这是小儿科啊 wzg356 发表于 2021-4-10 09:33
对你这是小儿科啊
我一点都不会编程别看我等级高 我只是喜欢根据工作内容 收集代码和程序 来提高工作效率 本帖最后由 wzg356 于 2021-4-11 15:12 编辑
原贴中
(setq eb(textbox es)
l(apply 'distance eb) w(cdr(assoc 40 es))
)
改为下面更准确
(setq eb(textbox es) p1(car eb)
l(distance p1(list(caadr eb)(cadr p1)))
w(distance p1(list(car p1)(cadadr eb)))
)
谢谢楼主分享。 感谢大佬分享~~~
页:
[1]