单行文本、多行文本加框（矩形、椭圆形框）

ljxkm

给文本加边框（矩形、椭圆形框）：
                 适用于单行文本、多行文本加框，选多少加多少，自己使用了一下，感觉还可以，有需要的可以试用一下，加载后输入命令tmtbox即可运行，祝开心啊!
       重新精简了代码，加上了加椭圆形框，txt-box.lsp为加矩形框，txt-ellbox.lsp为加椭圆形边框，命令就是文件名，批量选择，批量加框，非常方便，有需要的就下载吧。

ljxkm

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 ptlst  p1 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
   



(setq  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
  (princ "输入命令txt-box\n")
txt-ellbox.lsp文件内容：
  (defun c:txt-ellbox ( / oldos olderr en  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 ptlst  bb 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
    (setq  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 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

ljxkm 发表于 2020-3-30 19:21
哦，我下载的源代码贴给你，自己试一下，能用就用，不能用也没办法，实在需要，自己修改用一下，
  txt- ...

注意两个相近的函数可能有时会出现相互影响，先加载一个文件，执行命令后，再加载另一个文件，再执行另一个命令，如实在纠结要在一起使用，请自行更改函数及变量名称，贴出程序意在交流哈，免费的也不保证什么哈

ljxkm

stonedesign 发表于 2020-3-29 18:41
我知道呀     是你的2个插件用起来都是椭圆形边框

那就怪了，我从上面下载下来使用，一个是矩形一个是椭圆，没问题啊：
  矩形加载txt-box.lsp文件,命令行输入txt-box命令选择文字。
  椭圆加载txt-ellbox.lsp文件，命令行输入txt-ellbox命令选择文字

依然小小鸟

加的是矩形框还是圆框

ljxkm

矩形啊 ，还没想过加圆形啊，已矩形中心为圆心，长边为半径，画圆就可以了

renyonghua2014

支持楼主源码。
其实这个功能并不复杂，楼主应该能简化到极致的。

ljxkm

renyonghua2014 发表于 2019-8-12 17:03
支持楼主源码。
其实这个功能并不复杂，楼主应该能简化到极致的。

是的，后来又简化做了一个，搞了一个加椭圆框的，但觉得也没太大意思就没有贴出来了

he378980280

谢谢分享 。

yubihai

支持楼主源码

zhangcan0515

谢谢楼主分享 也学习一下

彳余

有没有矩形框倒角的那种，漂亮

haodong

多谢热心分享的朋友！