单行文本、多行文本加框（矩形、椭圆形框）
本帖最后由 ljxkm 于 2019-8-20 09:17 编辑给文本加边框（矩形、椭圆形框）：
适用于单行文本、多行文本加框，选多少加多少，自己使用了一下，感觉还可以，有需要的可以试用一下，加载后输入命令tmtbox即可运行，祝开心啊!
重新精简了代码，加上了加椭圆形框，txt-box.lsp为加矩形框，txt-ellbox.lsp为加椭圆形边框，命令就是文件名，批量选择，批量加框，非常方便，有需要的就下载吧。
stonedesign 发表于 2020-3-30 13:26
是的 我和你确定我也是下载的 快捷键就是你的文件名呀 弄出来的效果一样
哦，我下载的源代码贴给你，自己试一下，能用就用，不能用也没办法，实在需要，自己修改用一下，
txt-box.lsp文件：
(defun c:txt-box ( / oldos ollderr *error* ss i slst)
(vl-load-com)
(setvar "errno" 0)
(setq oldos (getvar "osmode"))
;;保存原有 *error*函数内容
(setq olderr *error*)
;;自定义错误函数
(defun *error* (msg)
(setq en (getvar "errno")
)
(setq errmsg (strcat "ERRNO=" (itoa en) "\nError:" msg)
)
(alert errmsg) ;以对话框形式显示错误信息
(setq *error* olderr) ;;;恢复原有的*error*函数内容
(setvar "osmode" oldos);;;;恢复原有的osmode值
)
(setvar "CMDECHO" 0);;;关闭命令回显
(setvar "osmode" 0)
(princ "\n请选择要加框的文字【单行、多行文字】")
(setq ss (ssget '((0 . "text,mtext"))))
(setq i 0
slst '()
)
(repeat (sslength ss)
(setq slst (cons (ssname ss i) slst)
i (1+ i)
)
);;;repeat
(foreach n slst (txbox n))
(setvar "osmode" oldos)
(setvar "CMDECHO" 1);;;打开命令回显
);;;;defun
(defun txbox (e / en zg ptlstp1 p2 p3 p4 p01 p02 p03 p04 lst1)
(setq en (entget e)
zg (cdr (assoc 40 en))
)
(cond
((= (cdr (assoc 0 en)) "TEXT")
(setq ptlst (get-textboxpoint e))
)
((= (cdr (assoc 0 en)) "MTEXT")
(setq ptlst (get-mtextboxpoint e)
)
)
)
(setq p1 (car ptlst)
p2 (cadr ptlst)
p3 (nth 2 ptlst)
p4 (nth 3 ptlst)
)
(setq p01 (polar p1 (- (angle p4 p1) (* pi 0.25)) (* zg 0.1414))
p02 (polar p2 (+ (angle p3 p2) (* pi 0.25)) (* zg 0.1414))
p03 (polar p3 (- (angle p2 p3) (* pi 0.25)) (* zg 0.1414))
p04 (polar p4 (+ (angle p1 p4) (* pi 0.25)) (* zg 0.1414))
)
(setq lst1 (list p01 p02 p03 p04 p01))
(entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length lst1)) (cons 8 "文字框") (cons 62 30))
(mapcar '(lambda (pt)(cons 10 pt)) lst1))
)
);;;defun
(defun get-textboxpoint (e / en p0 ang0 plst pt1 pt2 bb hh p1 p2 p3 p4) ;;;;;求单行文字四个角点
(setq en (entget e)
p0 (cdr (assoc 10 en))
ang0 (vla-get-Rotation (vlax-ename->vla-object e))
plst (textbox en)
pt1 (car plst)
pt2 (cadr plst)
bb (- (caadr plst) (caar plst))
hh (- (cadadr plst) (cadar plst))
)
(setq p1 (list (+ (car p0) (- (* (car pt1) (cos ang0)) (* (cadr pt1) (sin ang0))))
(+ (cadr p0) (+ (* (car pt1) (sin ang0)) (* (cadr pt1) (cos ang0))))
0.0
)
p2 (polar p1 ang0 bb)
P3 (polar p2 (+ ang0 (* pi 0.5)) hh)
P4 (polar p1 (+ ang0 (* pi 0.5)) hh)
)
(list p1 p2 p3 p4)
);;;defun
(defun get-mtextboxpoint (e / en p0 ang0 ms bb hh p1 p2 p3 p4) ;;;;;求多行文字四个角点
(setq en (entget e)
ang0 (vla-get-Rotation (vlax-ename->vla-object e))
p0 (cdr (assoc 10 en))
ms (cdr (assoc 71 en));;;;对齐方式
bb (cdr (assoc 42 en))
hh (cdr (assoc 43 en))
)
(cond;;;;求左下角点
((= ms 1);;;;左上
(setq p1 (polar p0 (- ang0 (* pi 0.5)) hh))
)
((= ms 2);;;;中上
(setq p1 (polar p0 (+ ang0 pi) (* bb 0.5))
p1 (polar p1 (- ang0 (* pi 0.5)) hh)
)
)
((= ms 3);;;;右上
(setq p1 (polar p0 (+ ang0 pi) bb)
p1 (polar p1 (- ang0 (* pi 0.5)) hh)
)
)
((= ms 4);;;;左中
(setq p1 (polar p0 (- ang0 (* pi 0.5)) (* hh 0.5))
)
)
((= ms 5);;;;正中
(setq p1 (polar p0 (+ ang0 pi) (* bb 0.5))
p1 (polar p1 (- ang0 (* pi 0.5)) (* hh 0.5))
)
)
((= ms 6);;;;右中
(setq p1 (polar p0 (+ ang0 pi) bb)
p1 (polar p1 (- ang0 (* pi 0.5)) (* hh 0.5))
)
)
((= ms 7);;;;左下
(setq p1 p0)
)
((= ms 8);;;;中下
(setq p1 (polar p0 (+ ang0 pi) (* bb 0.5)))
)
((= ms 9);;;;右下
(setq p1 (polar p0 (+ ang0 pi) bb))
)
);;;;cond
(setqp2 (polar p1 ang0 bb)
p3 (polar p2 (+ ang0 (* pi 0.5)) hh)
p4 (polar p1 (+ ang0 (* pi 0.5)) hh)
)
(list p1 p2 p3 p4)
);;;;defun
(princ "输入命令txt-box\n")
txt-ellbox.lsp文件内容：
(defun c:txt-ellbox ( / oldos olderr enss i slst)
(vl-load-com)
(setvar "errno" 0)
(setq oldos (getvar "osmode"))
;;保存原有 *error*函数内容
(setq olderr *error*)
;;自定义错误函数
(defun *error* (msg)
(setq en (getvar "errno")
)
(setq errmsg (strcat "ERRNO=" (itoa en) "\nError:" msg)
)
(alert errmsg) ;以对话框形式显示错误信息
(setq *error* olderr) ;;;恢复原有的*error*函数内容
(setvar "osmode" oldos);;;;恢复原有的osmode值
)
(setvar "CMDECHO" 0);;;关闭命令回显
(setvar "osmode" 0)
(princ "\n请选择要加框的文字【单行、多行文字】")
(setq ss (ssget '((0 . "text,mtext"))))
(setq i 0
slst '()
)
(repeat (sslength ss)
(setq slst (cons (ssname ss i) slst)
i (1+ i)
)
);;;repeat
(foreach n slst (txbox n))
(setvar "osmode" oldos)
(setvar "CMDECHO" 1);;;打开命令回显
);;;;defun
(defun txbox (e / enzg ptlstbb hh lst p1 p2 p3 p4 p01 p02
p03 p03 p04 lst1 p00 pc1 L1 L2 ofd)
(setq en (entget e)
zg (cdr (assoc 40 en))
)
(cond
((= (cdr (assoc 0 en)) "TEXT")
(setq ptlst (get-textboxpoint e))
)
((= (cdr (assoc 0 en)) "MTEXT")
(setq ptlst (get-mtextboxpoint e)
)
)
)
(setq ang0 (vla-get-Rotation (vlax-ename->vla-object e)))
(setq p1 (car ptlst)
p2 (cadr ptlst)
p3 (nth 2 ptlst)
p4 (nth 3 ptlst)
)
(setq p01 (polar p1 (- (angle p4 p1) (* pi 0.25)) (* zg 0.1414))
p02 (polar p2 (+ (angle p3 p2) (* pi 0.25)) (* zg 0.1414))
p03 (polar p3 (- (angle p2 p3) (* pi 0.25)) (* zg 0.1414))
p04 (polar p4 (+ (angle p1 p4) (* pi 0.25)) (* zg 0.1414))
)
(setq pc1 (mapcar '(lambda (x1 x2) (* (+ x1 x2) 0.5)) p01 p03))
(setq lst1 (list p1 p2 p3 p4 p1))
;;(entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length lst1)) (cons 8 "文字框") (cons 62 30))
;;(mapcar '(lambda (pt)(cons 10 pt)) lst1))
;;)
(setq p1 '(0 0 0)
bb (distance p01 p02)
hh (distance p02 p03)
p2 (polar p1 0 bb)
p3 (polar p2 (* pi 0.5) hh)
p4 (polar p1 (* pi 0.5) hh)
)
(setq p00 (mapcar '(lambda (x1 x2) (* (+ x1 x2) 0.5)) p1 p3))
(if (>= bb hh)
(progn
(setq L1 bb
L2 hh
)
)
(progn
(setq L1 hh
L2 bb
)
)
);;;;if
(emellipse p00 L1 L2)
(setq e1 (entlast))
(if (< bb hh)
(vla-rotate (vlax-ename->vla-object e1) (vlax-3d-point p00) (* pi 0.5))
)
(if (setq pmin (vlax-curve-getClosestPointTo (vlax-ename->vla-object e1) p3))
(setq ofd (distance pmin p3))
;;;(setq ofd (* (- L1 L2) 0.5))
)
(vla-offset (vlax-ename->vla-object e1) ofd)
(setq e2 (entlast))
(vla-delete (vlax-ename->vla-object e1))
(vla-rotate (vlax-ename->vla-object e2) (vlax-3d-point p00) ang0)
(vla-move (vlax-ename->vla-object (entlast)) (vlax-3d-point p00) (vlax-3d-point pc1))
)
(defun boxlst (e / obj ZX YS lst)
(setq obj (vlax-Ename->vla-object e))
(vla-GetBoundingBox obj 'ZX 'YS)
(setq lst (list (vlax-safearray->list ZX)
(vlax-safearray->list YS)
)
)
);;;;defun
(defun get-textboxpoint (e / en p0 ang0 plst pt1 pt2 bb hh p1 p2 p3 p4) ;;;;;求单行文字四个角点
(setq en (entget e)
p0 (cdr (assoc 10 en))
ang0 (vla-get-Rotation (vlax-ename->vla-object e))
plst (textbox en)
pt1 (car plst)
pt2 (cadr plst)
bb (- (caadr plst) (caar plst))
hh (- (cadadr plst) (cadar plst))
)
(setq p1 (list (+ (car p0) (- (* (car pt1) (cos ang0)) (* (cadr pt1) (sin ang0))))
(+ (cadr p0) (+ (* (car pt1) (sin ang0)) (* (cadr pt1) (cos ang0))))
0.0
)
p2 (polar p1 ang0 bb)
P3 (polar p2 (+ ang0 (* pi 0.5)) hh)
P4 (polar p1 (+ ang0 (* pi 0.5)) hh)
)
(list p1 p2 p3 p4)
);;;defun
(defun get-mtextboxpoint (e / en p0 ang0 ms bb hh p1 p2 p3 p4) ;;;;;求多行文字四个角点
(setq en (entget e)
ang0 (vla-get-Rotation (vlax-ename->vla-object e))
p0 (cdr (assoc 10 en))
ms (cdr (assoc 71 en));;;;对齐方式
bb (cdr (assoc 42 en))
hh (cdr (assoc 43 en))
)
(cond;;;;求左下角点
((= ms 1);;;;左上
(setq p1 (polar p0 (- ang0 (* pi 0.5)) hh))
)
((= ms 2);;;;中上
(setq p1 (polar p0 (+ ang0 pi) (* bb 0.5))
p1 (polar p1 (- ang0 (* pi 0.5)) hh)
)
)
((= ms 3);;;;右上
(setq p1 (polar p0 (+ ang0 pi) bb)
p1 (polar p1 (- ang0 (* pi 0.5)) hh)
)
)
((= ms 4);;;;左中
(setq p1 (polar p0 (- ang0 (* pi 0.5)) (* hh 0.5))
)
)
((= ms 5);;;;正中
(setq p1 (polar p0 (+ ang0 pi) (* bb 0.5))
p1 (polar p1 (- ang0 (* pi 0.5)) (* hh 0.5))
)
)
((= ms 6);;;;右中
(setq p1 (polar p0 (+ ang0 pi) bb)
p1 (polar p1 (- ang0 (* pi 0.5)) (* hh 0.5))
)
)
((= ms 7);;;;左下
(setq p1 p0)
)
((= ms 8);;;;中下
(setq p1 (polar p0 (+ ang0 pi) (* bb 0.5)))
)
((= ms 9);;;;右下
(setq p1 (polar p0 (+ ang0 pi) bb))
)
);;;;cond
(setqp2 (polar p1 ang0 bb)
p3 (polar p2 (+ ang0 (* pi 0.5)) hh)
p4 (polar p1 (+ ang0 (* pi 0.5)) hh)
)
(list p1 p2 p3 p4)
);;;;defun
(defun emellipse (pt czL dzL );;;pt为中心点，czL为长轴长度，dzL为短轴长度，11控制方向，为长轴左侧至中心点的x，y坐标
(entmake (list '(0 . "ELLIPSE") '(100 . "AcDbEntity") '(100 . "AcDbEllipse")(cons 10 pt)(cons 11 (list (* -1 czL 0.5) 0.0 0.0))
(cons 40 (/ dzl czl)) (cons 41 0) (cons 42 (* 2 pi)) (cons 8 "文字框") (cons 62 30)
)
)
)
ljxkm 发表于 2020-3-30 19:21
哦，我下载的源代码贴给你，自己试一下，能用就用，不能用也没办法，实在需要，自己修改用一下，
txt- ...
注意两个相近的函数可能有时会出现相互影响，先加载一个文件，执行命令后，再加载另一个文件，再执行另一个命令，如实在纠结要在一起使用，请自行更改函数及变量名称，贴出程序意在交流哈，免费的也不保证什么哈 stonedesign 发表于 2020-3-29 18:41
我知道呀 是你的2个插件用起来都是椭圆形边框
那就怪了，我从上面下载下来使用，一个是矩形一个是椭圆，没问题啊：
矩形加载txt-box.lsp文件,命令行输入txt-box命令选择文字。
椭圆加载txt-ellbox.lsp文件，命令行输入txt-ellbox命令选择文字 加的是矩形框还是圆框 矩形啊 ，还没想过加圆形啊，已矩形中心为圆心，长边为半径，画圆就可以了 支持楼主源码。
其实这个功能并不复杂，楼主应该能简化到极致的。 renyonghua2014 发表于 2019-8-12 17:03
支持楼主源码。
其实这个功能并不复杂，楼主应该能简化到极致的。
是的，后来又简化做了一个，搞了一个加椭圆框的，但觉得也没太大意思就没有贴出来了 谢谢分享 。
支持楼主源码 谢谢楼主分享 也学习一下 有没有矩形框倒角的那种，漂亮 多谢热心分享的朋友！