136724140 发表于 2016-10-17 09:34:07

将单行/多行文字合并

在论坛中看见荒野孤行 发布的帖子将多行文字合并http://bbs.mjtd.com/forum.php?mod=viewthread&tid=171203&highlight=%B6%E0%D0%D0%CE%C4%D7%D6   如何修改可以使合并后的多行文字还保留原来颜色
源码如下：
;;;*****文字合并 程序开始*****
(defun c:hb (/ 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)
)
;;;*****文字合并 程序结束*****

vectra 发表于 2016-10-17 22:10:41

本帖最后由 vectra 于 2016-10-18 10:54 编辑

(defun c:hb (/ delim dxf ename height lst n ss str)
(if (and
        (setq ss (ssget '((0 . "*TEXT"))))
        ;;        (setq p (getpoint "指定合并后文字位置:"))
      )
    (progn
      (setvar "cmdecho" 0)
      (command "undo" "be")
      (setq delim""
          height (cdr (assoc 40 (entget (ssname ss 0))))
      )

      (repeat (setq n (sslength ss))
        (setq ename (ssname ss (setq n (1- n)))
              dxf   (entget ename)
              lst   (cons (list        (cdr (assoc 10 dxf))
                                (cdr (assoc 1 dxf))
                                (cdr (assoc 62 dxf))
                          )
                          lst
                  )
        )
        (entdel ename)
      )
      (setq
        lst
       (vl-sort lst
                  (function
                  (lambda (e1 e2)
                      (< (car (car e1)) (car (car e2)))
                  )
                  )
       )
      )
      (setq str "{")
      (foreach e lst
        (if (null (nth 2 e))
          (setq str (strcat str (cadr e) delim))
          (setq str (strcat str "\\C" (itoa (nth 2 e)) ";" (cadr e) delim))
        )
      )
      (setq str (strcat str "}"))

      (entmake (list '(0 . "MTEXT")
                     '(100 . "AcDbEntity")
                     '(100 . "AcDbMText")
                     (cons 71 7)
                     (cons 40 height)
                     (cons 10 (caar lst))
                     (cons 1 str)
             )
      )

      (command "undo" "e")
    )
    (princ)
)
)

136724140 发表于 2016-10-18 08:41:00

vectra 发表于 2016-10-17 22:10


这个合并后多行文字颜色还都是随层呀不是合并前文字的颜色

vectra 发表于 2016-10-18 08:49:12

这个 模板都有了 自己加两行就行了啊 比如你想要怎么决定多个对象中以谁的颜色或层图为准啦 什么的

代码更新了，增加了颜色设置

136724140 发表于 2016-10-18 09:24:08

vectra 发表于 2016-10-18 08:49
这个 模板都有了 自己加两行就行了啊 比如你想要怎么决定多个对象中以谁的颜色或层图为准啦 什么的

代 ...


具体如图，要合并的多行文字有不同的颜色，怎样能在合并时候还保留他的原来颜色

vectra 发表于 2016-10-18 10:55:58

基本上针对楼主的场景重写了
页: [1]
查看完整版本: 将单行/多行文字合并