wgij007 发表于 2019-11-8 16:47:50

请问文字合拼后能不能直接全部对中

;;;*****文字合并 程序开始*****
(defun c:hbh (/ lst)
(setq oldaun (getvar "aunits"))
(setvar "aunits" 3)
(setvar "osmode" 15359)
(setvar "cmdecho" 0)
(command "undo" "be")
(princ "\n★功能:文字合并。\n \n")
(setq ss (ssget '((0 . "MTEXT,TEXT"))))
(setvar "osmode" 0)
(initget "E S A")
(if (not (setq kword
                  (getkword
                  "\n在合并文字之间加:[换行(E)/空格(S)/直接合并(A)]<E>"
                  )
         )
      )
    (setq kword "E")
)
(setvar "osmode" 0)
(setq lst '())
(while (> (sslength ss) 0)
    (setq entnam (ssname ss 0)
          entdat (entget entnam)
    )
    (setq pt(cdr (assoc 10 entdat))      ;读取文字的插入点坐标
          txt (cdr (assoc 1 entdat))      ;读取文字内容
          zg(cdr (assoc 40 entdat))      ;读取文字的字高
          lst (cons (list pt txt zg) lst) ;将点坐标、内容、字高组成表
          ss(ssdel entnam ss)                ;选择集中删除当前的文字对象
    )
    (entdel entnam)                        ;删除文字对象
)
(setq
    lst
   (vl-sort lst
(function
                (lambda      (e1 e2)
                  (if (equal (cadr (car e1)) (cadr (car e2)) 1e-4)
                  (> (car (car e1)) (car (car e2)))
                  (< (cadr (car e1)) (cadr (car e2)))
                  )
                )
            )
   )
)
(setq str "")
(cond      ((= kword "S")
         (foreach e lst
         (setq str (strcat (cadr e) " " str))
         )
      )
      ((= kword "E")
         (foreach e lst
         (setq str (strcat (cadr e) "\n" str))
         )
      )
      ((= kword "A")
         (foreach e lst
         (setq str (strcat (cadr e) str))
         )
      )
)
(command "MTEXT" pt "H" zg "W" 0 str "")
(princ "\n★提示:文字合并完成.\n")
(princ)
(setvar "aunits" oldaun)
(command "undo" "e")
(setvar "osmode" 15359)
(princ)
)
;;;*****文字合并 程序结束****


页: [1]
查看完整版本: 请问文字合拼后能不能直接全部对中