某网友要的文字打断程序,做好了进来下载吧

crtrccrt

修改 2012-10-03  快捷键是大小写都支持

;;; ===================================================
;;; 功能：文字打断(a d键改变分割的位置,左键确定,右键退出)
;;; 作者：langjs      命令:aa     日期:2012年9月
;;; 修改 2012-10-03  快捷键是大小写都支持
;;; ===================================================
(defun c:aa (/ a_data a_list ang box code color data ent ent2 gr i lst m n name name2 nn num num2 pt pt1 pt2 ss sss str strlst texth
                txt w x
             )
   (defun sublst (lst n m / i str x)    ; 提取表中元素组成字符串
     (setq i 1  str "" )
     (foreach x lst
       (progn
         (if (and (>= i n) (<= i m)) (setq str (strcat str x)))
         (setq i (1+ i))
       ))
     str
   )
   (defun stringtolist (sss / a_data a_list nn) ; 分解字符串成表
     (while (/= sss "")
       (setq a_data (logand 224 (ascii sss)))
       (if (or (= a_data 224)   (= a_data 128))
         (progn
           (setq a_list (append a_list(list (substr sss 1 2))))
           (setq sss (substr sss 3))
         )
         (progn
           (if (> (ascii (setq nn (substr sss 1 1))) 160)
             (setq nn (substr sss 1 2) sss (substr sss 3))
             (setq sss (substr sss 2))
           )
           (setq a_list (append  a_list (list nn) ) )
         )))
     a_list
   )
   (defun makepline (pt1 pt2 w color / ent name) ; 生成线
     (setq ent (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 62 color) (cons 90 2)
                              (cons 43 w) (cons 10 pt1) (cons 10 pt2)
                        )))
     (setq name (entlast))
     name
   )
   (defun #err988 (s)                   ; 出错处理
     (entdel name2)
     (setq *error* $orr)
   )
   (setvar "cmdecho" 0)
   (vl-load-com)
   (setq $orr *error*)
   (setq *error* #err988)
   (while (not (setq ss (ssget ":E:S" '((0 . "TEXT")))))
     (if (= (getvar "ERRNO") 52) (vl-exit-with-error ""))
   )
   (setq name (ssname ss 0)   ent (entget name)  txt (cdr (assoc 1 ent))
         pt (cdr (assoc 10 ent)) texth (cdr (assoc 40 ent)) ang (cdr (assoc 50 ent))
         name2 (makepline pt (polar pt (+ ang (/ pi 2)) texth) (* 0.05 texth) 1)
         strlst (stringtolist txt)    num 0    num2 (length strlst)
   )
   (princ "\n [A] [D] 键改变分割的位置,左键确定,右键退出:")
   (while (progn
            (setq gr (grread t 15 0)  code (car gr)  data (cadr gr) )
            (cond
              ((= code 2)
                (cond
                  ((and (= (strcase "a") (strcase (vl-list->string (cdr gr))))(> num 0))
                    (setq num (1- num))
                  )
                  ((and (= (strcase "d") (strcase (vl-list->string (cdr gr))))(< num (length strlst)))
                    (setq num (1+ num))
                  )
                )
                (entdel name2)
                (if (= num 0)
                  (setq name2 (makepline pt (polar pt (+ ang (/ pi 2)) texth) (* 0.05 texth) 1))
                  (setq ent2 (cdr (subst (cons 1 (sublst strlst 1 num))(assoc 1 ent)  ent ))
                        box (textbox ent2) pt1 (polar pt ang (+ (car (car (cdr box))) (car (car box))))
                        name2 (makepline pt1 (polar pt1 (+ ang (/ pi 2)) texth) (* 0.05 texth) 1)
                  ))
              )
              ((= code 3)
                (if (or (= num 0)(= num num2))
                  (entdel name2)
                  (progn
                    (entdel name)
                    (entmake ent2)
                    (entdel name2)
                    (setq ent2 (subst (cons 1 (sublst strlst (1+ num) num2)) (assoc 1 ent) ent ))
                    (entmake (subst (cons 10 pt1)(assoc 10 ent2) ent2))
                  ))
                (vl-exit-with-error "")
              )
              ((or (= code 11) (= code 25))
                (entdel name2)
                (vl-exit-with-error "")
              )
            )
            t
          )
   )
   (setq *error* $orr)
   (princ)
)

yoyoho

谢谢楼主的分享！
谢谢！

lohas1118

不错的程序

xotoo

可不可以让打断后的后半部分的文字基点自动变成左上？

ynhh

大师的精神是明经上的榜样，请大师有空时能不能写一个程序，把图中所有各种标注的精度设置为小数点后几位数的程序啊。

lish

学习了！！！！！！！！！！！

meja

支持中文很好，但是为什么不直接用鼠标打断呢？

wjnnan

正在找这样的程序，真是及时啊

树櫴希德

支持中文很好，但是为什么不直接用鼠标打断呢

泥水匠乐悠悠

程序好，人更好