文字实际最小包围框，自己理解最适用，绕弯反而简单

wzg356

;==============
;文字实际最小包围框 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))
)

xj6019

你很伟大 分享了那么多好的代码  

xujinhua

谢谢楼主分享，学习一下

wzg356

应用例子
文字下划线标注
(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)

还有一个应用场景 文字加框（包括加方框和圆框）  可以开发一下代码吗

wzg356

依然小小鸟 发表于 2021-4-10 09:30
还有一个应用场景 文字加框（包括加方框和圆框）  可以开发一下代码吗

对你这是小儿科啊

依然小小鸟

wzg356 发表于 2021-4-10 09:33
对你这是小儿科啊

我一点都不会编程  别看我等级高 我只是喜欢根据工作内容 收集代码和程序 来提高工作效率

wzg356

原贴中
(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)))
)

panliang9

谢谢楼主分享。

magicheno

感谢大佬分享~~~