求解类似于这功能的，有高手简化吗

lenovo1x1

  在明经里找到的，如下图，但是我想实现我第二张图的效果或者如第三张图炸开行吗
   ，求高手简化或解答，源代码如下。

                                 


                                       

                                      


(defun c:SBJJ ( / ang_text b_find badd bo2 box1 box2 dl e e1 e2 edata elist ell en ename ent etext f_width i i_length ipos lendelimiter lensource lst1 lstresult lstsource lstsub minx n newe pt ptt sdelimiter sname ss ss1 ssource str str_current str_defined str_given str_lst_return str_lst_temp str_lst_text str_text string string1 string2 strlst_defined strlst_defined2 text x)
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun wzhb(ss /  i ename dl ell x text e1 e2)
    (setq         i  0
                  dl nil
                  minx nil
        );setq
        (if ss
            (progn
                        (repeat (sslength ss)
                                (setq ename (ssname ss i)
                                          ell    (entget ename)
                                          x      (cadr (assoc 10 ell))
                                          text   (cdr (assoc 1 ell))
                                          i      (1+ i)
                                );setq
                                (setq dl (append dl (list (list x text ename))))
                        );repeat
                        (setq dl    (vl-sort dl (function (lambda (e1 e2) (< (car e1) (car e2)))))
                          i     1
                              text  (cadr (nth 0 dl))
                              ename (caddr (nth 0 dl))
                              ell   (entget ename)
                        );setq
                        (repeat (- (length dl) 1)
                                (setq text (strcat text (cadr (nth i dl))))
                                (entdel (caddr (nth i dl)))
                                (setq i (1+ i))
                        );repeat
                        (setq ell (subst (cons 1 text) (assoc 1 ell) ell))
                        (entmod ell)
                        (entupd ename)
                );progn
        );if
        (princ)
)


;=====================================================
;=================    文字打断     ===================
;=====================================================
;打断所有文字
(defun wzcf ( ss /  i n )
  (if ss
    (progn
      (if (= 0 (boole 1 8 (getvar 'undoctl))) (command "_.undo" "_group"))
      (setq i -1
            n (sslength ss)
            )
      (while (< (setq i (1+ i)) n)
        (if (and (setq ss2 (EF_Text:BreakAll (ssname ss i)) )
                 (> (sslength ss2) 1)
                 )
          (EF:PickSet-Group ss2 "文字炸开")
          )
        )
      (if (= 8 (boole 1 8 (getvar 'undoctl))) (command "_.undo" "_end"))
      )
    )
  )
;将ss成组
(defun EF:PickSet-Group (ss sName / )
  (command "Group" "C" "*" sName ss "")
  )
;文字打断所有
(defun EF_Text:BreakAll (eText        ;待炸开的文字
                         /
                         ss
                         edata
                         str_Text
                         str_lst_Text
                         ang_Text
                         pt
                         )
  (setq ss (ssadd))
  (setq edata (entget eText))
  (setq str_Text (cdr (assoc 1 edata)))
  (setq str_lst_Text (EF_Text:StringExplode str_Text)
        ) ;将字符串拆解成单字列表

  (if (or (= (assoc 72 edata) 3)        ;对齐方式对齐
          (= (assoc 72 edata) 5)        ;对齐方式拟合
          )
    (setq ang_Text (angle (cdr (assoc 10 edata)) (cdr (assoc 11 edata))))
    (setq ang_Text (cdr (assoc 50 edata)))
    )

  (setq pt (cdr (assoc 10 edata)))
  (setq edata (list '(0 . "TEXT")
                    (assoc 8 edata)        ;图层
                    (assoc 40 edata)        ;高度
                    (assoc 41 edata)        ;宽度
                    (assoc 7 edata)        ;样式
                    (assoc 71 edata)        ;文字镜像
                    (cons 50 ang_Text)        ;转角
                    (assoc 51 edata)        ;倾角
                    )
        )
  (while str_lst_Text
    (setq str_Current (car str_lst_Text))
    (setq f_Width (EF_Text:getTextWidth str_Current edata))

    ;(EF-Text-PointWrite str_Current pt edata) ;按实际插入点填写文字
;;;    (if (and (/= str_Current " ") (/= str_Current "　"))
;;;      (progn
        (entmake (EF:List-SubstAssoc (list (cons 1 str_Current) (cons 10 pt)) edata T))
        (setq ss (ssadd (entlast) ss))
;;;        )
;;;      )
    (if (= (boole 1 (cdr (assoc 71 edata)) 2) 2)
      (setq pt (polar pt ang_Text (- 0 f_Width)))
      (setq pt (polar pt ang_Text f_Width))
      )
    (setq str_lst_Text (cdr str_lst_Text))
    )
  (entdel eText)
  ss
  )
;=============================================================;
;拆分字符串                                                   ;
;EF_Text:StringExplode                                        ;
;=============================================================;
;取得 空格 宽度
(defun EF_Text:getTextWidth (str        ;需要检测的字符串,如果为nil则取 edata
                             edata        ;需要检测的文字样式图元表
                             /
                             box1 bo2
                             )
  (if (not str) (setq str (cdr (assoc 1 edata))))
  (setq box1 (textbox (EF:List-SubstAssoc (list (cons 1 (strcat "m" str "m"))) edata T)))
  (setq box2 (textbox (EF:List-SubstAssoc (list (cons 1 "mm")) edata T)))
  (- (- (caadr box1) (caar box1))
     (- (caadr box2) (caar box2))
     )
  )

;获取打断排除列表(单字符)
(defun EF_Text:getBreakDefined ( / )
  (EF:String->List "%%130||%%131||%%132||%%133||%%134||%%135||%%136||%%p||%%P||%%c||%%C" "||")
  )

;获取打断排除列表(成对字符)
(defun EF_Text:getBreakDefined2 ( / )
  (mapcar '(lambda (e)
             (EF:String->List e "*")
             )
          (EF:String->List "%%140*%%141||%%142*%%143||%%200*%%201||%%202*%%203||%%204*%%205" "||")
          )
  )

;字符串拆分
(defun EF_Text:StringExplode (str_Given                ;需要转换的字符串
                              /
                              strlst_Defined        ;单定义字符  例：'("%%130" "%%131" "%%132" "%%p" ...)
                              strlst_Defined2        ;成对定义字符 例 '((%%200 %%201) (%%202 %%203))
                              
                              b_Find                ;是否找到特殊字符串
                              str_Defined        ;特殊字符串
                              i_Length                ;特殊字符串 长度
                              str_lst_Return        ;返回字符串列表
                              e
                              )
  (setq strlst_Defined (EF_Text:getBreakDefined))
  (setq strlst_Defined2 (EF_Text:getBreakDefined2))
  ;检查字符串首是否在特殊字符串列表中
  (while (> (strlen str_Given) 0)
    (setq b_Find nil)
    ;检查 单定义字符
    (setq str_lst_Temp strlst_Defined)
    (while (and str_lst_Temp (not b_Find))
      (setq str_Defined (car str_lst_Temp ))
      (setq i_Length (strlen str_Defined))
      (if (= (substr str_Given 1 i_Length) str_Defined)
        (setq b_Find T)
        )
      (setq str_lst_Temp (cdr str_lst_Temp))
      )
    ;检查 成对定义字符
    (setq str_lst_Temp strlst_Defined2)
    (while (and str_lst_Temp (not b_Find))
      (setq str_Defined (caar str_lst_Temp ))
      (setq i_Length (strlen str_Defined))
      (if (= (substr str_Given 1 i_Length) str_Defined)
        (progn
          (setq b_Find T)
          (setq str_Defined (car str_lst_Temp))
          )
        )
      (setq str_lst_Temp (cdr str_lst_Temp))
      )

    (cond (b_Find        ;特殊字符串
           (progn
             (if (equal (type str_Defined) 'STR)
               (progn
                 (setq str_lst_Return (cons str_Defined str_lst_Return))
                 (setq str_Given (substr str_Given (1+ i_Length)))
                 )
               (progn
                 (if (setq i (vl-string-search (cadr str_Defined) str_Given))
                   (progn
                     (setq e (substr str_Given 1 (+ i (strlen (cadr str_Defined)))))
                     (setq str_lst_Return (cons e str_lst_Return))
                     (setq str_Given (substr str_Given (+ 1 i (strlen (cadr str_Defined)))))
                     )
                   (progn
                     (setq str_lst_Return (cons (car str_Defined) str_lst_Return))
                     (setq str_Given (substr str_Given (1+ i_Length)))
                     )
                   )                 
                 )
               )
             )
           )
          ((> (ascii (substr str_Given 1 1)) 128)        ;大于128为汉字
           (setq str_lst_Return (cons (substr str_Given 1 2) str_lst_Return))
           (setq str_Given (substr str_Given 3))
           )
          (T
           (setq str_lst_Return (cons (substr str_Given 1 1) str_lst_Return))
           (setq str_Given (substr str_Given 2))
           )
          )
    )
  (reverse str_lst_Return)
  )

;将字符串字符串以 给定 Key 分解成
;例：(EF:String->list "a,b,c" ",") →("a" "b" "c")
(defun EF:String->list (sSource sDelimiter / lenSource lenDelimiter iPos lstResult)
  (if (= sDelimiter "") (progn (princ "EF:String->list 分割参数不能为空字符\"\"") (exit)))
  (setq
    lenSource (strlen sSource)
    lenDelimiter (strlen sDelimiter)
  )
  (while (setq iPos (vl-string-search sDelimiter sSource))
    (setq
      lstResult (cons (substr sSource 1 iPos) lstResult)
      sSource (substr sSource (+ 1 iPos lenDelimiter))
    )
  )
  (reverse (cons sSource lstResult))
) ;_ end EF:String->list
;根据 lstSub 子表中的首元素 替换 lstSource 中对应表元
(defun EF:List-SubstAssoc (lstSub        ;需要替换的列表
                           lstSource        ;源列表
                           bAdd                ;是否向源列表中追加 原本没有的元素
                           /
                           e1
                           )
  (foreach e lstSub
    (if (setq e1 (assoc (car e) lstSource))
      (setq lstSource (subst e (assoc (car e) lstSource) lstSource))
      (if bAdd (setq lstSource (append lstSource (list e))))
      )
    )
  lstSource
  )
;删除选择集
(defun EF:PickSet-Erase (ss  / e )
  (while (> (sslength ss) 0)
    (setq e (ssname ss 0))
    (setq ss (ssdel e ss))
    (entdel e)
    )
  )
;选择集并集
(defun EF:PickSet-Join (ss1        ;第一选择集
                        ss2        ;第二选择集
                        / i n ename)
  (setq i -1)
  (setq n (sslength ss1))
  (while (< (setq i (1+ i)) n)
    (setq ss2 (ssadd (ssname ss1 i) ss2))
    )
  ss2
  )
;选择集→元素列表
(defun EF:PickSet-toList ( ss  / i eList)
  (setq i 0)
  (if (equal (type ss) 'PICKSET)
    (while (< i (sslength ss))
      (setq eList (cons (ssname ss i) eList))
      (setq i (1+ i))
      )
    )
  eList
  )
;元素列表→选择集
(defun EF:PickSet-fromList ( eList / ss )
  (setq ss (ssadd))
  (while eList
    (if (equal (type (car eList)) 'ENAME)
      (setq ss (ssadd (car eList) ss))
      )
    (setq eList (cdr elist))
    )
  ss
  )
  (princ "\n请点选要修改的字符:(左键+1右键-1)")
  (while
    (cond ((and        (setq pt (grread t 4 2)) ;获取grread值
                (equal (car pt) 5)
           )
           (progn
             (setq ptt (cadr pt)
                   en  (car (nentselp ptt))
             )
             (setq ss(ssadd))
             t
           )
          )
          ((and (equal (car pt) 3) en );_Mouse Left button  如果=3为左键
           (progn
            (ssadd en ss)
            (wzcf ss)
            (setq lst1(EF:PickSet-toList ss2))
            (setq newe(car(nentselp ptt)))
           (if
             (and (setq ent (entget newe)) ;获取图元
                  (setq str (cdr (assoc 1 ent))) ;读取数值
                  (cond
                  ((< 47 (setq strascii (ascii str)) 58)
                   (if (> (1+ strascii) 57)
                     (setq string (chr 48))
                     (setq string (chr (1+ strascii)))
                   )
                   )
                  ((< 64 strascii 91)
                   (if (> (1+ strascii) 90)
                     (setq string (chr 65))
                     (setq string (chr (1+ strascii)))
                   )
                   )
                  ((< 96 strascii 123)
                   (if (> (1+ strascii) 122)
                     (setq string (chr 97))
                     (setq string (chr (1+ strascii)))
                   )
                   )
                  ((= str "零")(setq string "一"))
                  ((= str "一")(setq string "二"))
                  ((= str "二")(setq string "三"))
                  ((= str "三")(setq string "四"))
                  ((= str "四")(setq string "五"))
                  ((= str "五")(setq string "六"))
                  ((= str "六")(setq string "七"))
                  ((= str "七")(setq string "八"))
                  ((= str "八")(setq string "九"))
                  ((= str "九")(setq string "十"))
                  ((= str "十")(setq string "零"))
                  (t (princ "\n非数值或字母!")nil)
                  )
             )
              (progn
                (setq ent (subst (cons 1 string) (assoc 1 ent) ent))
                (entmod ent)                ;更新实体数据库
              )
           )
              (setq ss3(EF:PickSet-fromList lst1))
              (wzhb ss2)
            )
          )
          ((and (or (equal (car pt) 11) (equal (car pt) 25)) en);_Mouse Right button  如果=11为右键
            (ssadd en ss)
            (wzcf ss)
            (setq lst1(EF:PickSet-toList ss2))
            (setq newe(car(nentselp ptt)))
           (if
             (and (setq ent (entget newe)) ;获取图元
                  (setq str (cdr (assoc 1 ent))) ;读取数值
                  (cond
                  ((< 47 (setq strascii (ascii str)) 58)
                   (if (< (1- strascii) 48)
                     (setq string (chr 57))
                     (setq string (chr (1- strascii)))
                   )
                   )
                  ((< 64 strascii 91)
                   (if (< (1- strascii) 65)
                     (setq string (chr 90))
                     (setq string (chr (1- strascii)))
                   )
                   )
                  ((< 96 strascii 123)
                   (if (< (1- strascii) 97)
                     (setq string (chr 122))
                     (setq string (chr (1- strascii)))
                   )
                   )
                  ((= str "零")(setq string "十"))
                  ((= str "一")(setq string "零"))
                  ((= str "二")(setq string "一"))
                  ((= str "三")(setq string "二"))
                  ((= str "四")(setq string "三"))
                  ((= str "五")(setq string "四"))
                  ((= str "六")(setq string "五"))
                  ((= str "七")(setq string "六"))
                  ((= str "八")(setq string "七"))
                  ((= str "九")(setq string "八"))
                  ((= str "十")(setq string "九"))
                  (t (princ "\n非数值或字母!")nil)
                  )
             )
              (progn
                (setq ent (subst (cons 1 string) (assoc 1 ent) ent))
                (entmod ent)                ;更新实体数据库
              )
           )
          (setq ss3(EF:PickSet-fromList lst1))
          (wzhb ss2)
          )
    )

  )
  (setq ss2 nil ss3 nil)

  (princ)
)
(princ"\nAutor springwillow")

自贡黄明儒

下一步，先看这个帖子
http://bbs.mjtd.com/forum.php?mo ... D108%26typeid%3D108

((= str "零")(setq string "一"))
                  ((= str "一")(setq string "二"))
                  ((= str "二")(setq string "三"))
                  ((= str "三")(setq string "四"))
                  ((= str "四")(setq string "五"))
                  ((= str "五")(setq string "六"))
                  ((= str "六")(setq string "七"))
                  ((= str "七")(setq string "八"))
                  ((= str "八")(setq string "九"))
                  ((= str "九")(setq string "十"))
                  ((= str "十")(setq string "零"))
                  (t (princ "\n非数值或字母!")nil)
上面这段可以这样写
(setq L '("零" "一" "二" "三""四"))(setq str "一")
(nth (1- (VL-POSITION str)) L)