将单行/多行文字合并

136724140

在论坛中看见  荒野孤行 发布的帖子将多行文字合并http://bbs.mjtd.com/forum.php?mo ... 0%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

1. (defun c:hb (/ delim dxf ename height lst n ss str)
   
2.   (if (and
   
3.         (setq ss (ssget '((0 . "*TEXT"))))
   
4.         ;;        (setq p (getpoint "指定合并后文字位置:"))
   
5.       )
   
6.     (progn
   
7.       (setvar "cmdecho" 0)
   
8.       (command "undo" "be")
   
9.       (setq delim  ""
   
10.             height (cdr (assoc 40 (entget (ssname ss 0))))
    
11.       )
    
12. 
    
13.       (repeat (setq n (sslength ss))
    
14.         (setq ename (ssname ss (setq n (1- n)))
    
15.               dxf   (entget ename)
    
16.               lst   (cons (list        (cdr (assoc 10 dxf))
    
17.                                 (cdr (assoc 1 dxf))
    
18.                                 (cdr (assoc 62 dxf))
    
19.                           )
    
20.                           lst
    
21.                     )
    
22.         )
    
23.         (entdel ename)
    
24.       )
    
25.       (setq
    
26.         lst
    
27.          (vl-sort lst
    
28.                   (function
    
29.                     (lambda (e1 e2)
    
30.                       (< (car (car e1)) (car (car e2)))
    
31.                     )
    
32.                   )
    
33.          )
    
34.       )
    
35.       (setq str "{")
    
36.       (foreach e lst
    
37.         (if (null (nth 2 e))
    
38.           (setq str (strcat str (cadr e) delim))
    
39.           (setq str (strcat str "\\C" (itoa (nth 2 e)) ";" (cadr e) delim))
    
40.         )
    
41.       )
    
42.       (setq str (strcat str "}"))
    
43. 
    
44.       (entmake (list '(0 . "MTEXT")
    
45.                      '(100 . "AcDbEntity")
    
46.                      '(100 . "AcDbMText")
    
47.                      (cons 71 7)
    
48.                      (cons 40 height)
    
49.                      (cons 10 (caar lst))
    
50.                      (cons 1 str)
    
51.                )
    
52.       )
    
53. 
    
54.       (command "undo" "e")
    
55.     )
    
56.     (princ)
    
57.   )
    
58. )

(defun c:hb (/ delim dxf ename height lst n ss str)<br />   (if (and<br />         (setq ss (ssget '((0 . "*TEXT"))))<br />         ;;        (setq p (getpoint "指定合并后文字位置:"))<br />       )<br />     (progn<br />       (setvar "cmdecho" 0)<br />       (command "undo" "be")<br />       (setq delim  ""<br />             height (cdr (assoc 40 (entget (ssname ss 0))))<br />       )<br /> <br />       (repeat (setq n (sslength ss))<br />         (setq ename (ssname ss (setq n (1- n)))<br />               dxf   (entget ename)<br />               lst   (cons (list        (cdr (assoc 10 dxf))<br />                                 (cdr (assoc 1 dxf))<br />                                 (cdr (assoc 62 dxf))<br />                           )<br />                           lst<br />                     )<br />         )<br />         (entdel ename)<br />       )<br />       (setq<br />         lst<br />          (vl-sort lst<br />                   (function<br />                     (lambda (e1 e2)<br />                       (< (car (car e1)) (car (car e2)))<br />                     )<br />                   )<br />          )<br />       )<br />       (setq str "{")<br />       (foreach e lst<br />         (if (null (nth 2 e))<br />           (setq str (strcat str (cadr e) delim))<br />           (setq str (strcat str "\\C" (itoa (nth 2 e)) ";" (cadr e) delim))<br />         )<br />       )<br />       (setq str (strcat str "}"))<br /> <br />       (entmake (list '(0 . "MTEXT")<br />                      '(100 . "AcDbEntity")<br />                      '(100 . "AcDbMText")<br />                      (cons 71 7)<br />                      (cons 40 height)<br />                      (cons 10 (caar lst))<br />                      (cons 1 str)<br />                )<br />       )<br /> <br />       (command "undo" "e")<br />     )<br />     (princ)<br />   )<br /> )

136724140

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

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

vectra

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

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

136724140

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

代 ...

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

vectra

基本上针对楼主的场景重写了