能改为合拼后，上下，左右，都对中(居中)吗

wgij007

;;;*****文字合并 程序开始*****
(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)
)
;;;*****文字合并 程序结束****



能改为合拼后，上下，左右，都对中(居中)吗

ZZXXQQ

1. ;;;*****文字合并 程序开始*****
   
2. (defun c:hbh (/ lst)
   
3. (setq oldaun (getvar "aunits"))
   
4. (setvar "aunits" 3)
   
5. (setvar "osmode" 15359)
   
6. (setvar "cmdecho" 0)
   
7. (command "undo" "be")
   
8. (princ "\n★功能：文字合并。\n \n")
   
9. (setq ss (ssget '((0 . "MTEXT,TEXT"))))
   
10. (setvar "osmode" 0)
    
11. (initget "E S A")
    
12. (if (not (setq kword (getkword "\n在合并文字之间加：[换行(E)/空格(S)/直接合并(A)]<E>")))
    
13.   (setq kword "E")
    
14. )
    
15. (setq lst '())
    
16. (while (> (sslength ss) 0)
    
17.   (setq entnam (ssname ss 0)
    
18.        entdat (entget entnam)
    
19.   )
    
20.   (setq pt (cdr (assoc 10 entdat)) ;读取文字的插入点坐标
    
21.        txt (cdr (assoc 1 entdat)) ;读取文字内容
    
22.        zg (cdr (assoc 40 entdat)) ;读取文字的字高
    
23.        lst (cons (list pt txt zg) lst) ;将点坐标、内容、字高组成表
    
24.        ss (ssdel entnam ss) ;选择集中删除当前的文字对象
    
25.   )
    
26.   (entdel entnam) ;删除文字对象
    
27. )
    
28. (setq lst
    
29.   (vl-sort lst
    
30.    (function
    
31.     (lambda (e1 e2)
    
32.      (if (equal (cadar e1) (cadar e2) 1e-4) ;Y坐标
    
33.       (> (caar e1) (caar e2)) ;X坐标
    
34.       (< (cadar e1) (cadar e2)) ;Y坐标
    
35.      )
    
36.     )
    
37.    )
    
38.   )
    
39. )
    
40. (setq str "")
    
41. (cond
    
42.   ((= kword "S")
    
43.    (foreach e lst (setq str (strcat (cadr e) " " str)))
    
44.   )
    
45.   ((= kword "E")
    
46.    (foreach e lst (setq str (strcat (cadr e) "\n" str)))
    
47.   )
    
48.   ((= kword "A")
    
49.    (foreach e lst (setq str (strcat (cadr e) str)))
    
50.   )
    
51. )
    
52. (command "MTEXT" pt "H" zg "J" "MC" "W" 0 str "")
    
53. (princ "\n★提示:文字合并完成.\n")
    
54. (setvar "aunits" oldaun)
    
55. (command "undo" "e")
    
56. (setvar "osmode" 15359)
    
57. (princ)
    
58. )
    
59. ;;;*****文字合并 程序结束****
    

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

wgij007

ZZXXQQ 发表于 2019-12-9 10:25

谢谢，感激.....................