[编程交流] 单行堆叠多行文字梳

(defun c:Combine (/ ss)
 ;; Combine MText and Text (sorted by Y value) into top most text object
 ;; Alan J. Thompson, 09.24.10
 (vl-load-com)
 (if (setq ss ((lambda (ss i / e l lst)
                 (if ss
                   (while (setq e (ssname ss (setq i (1+ i))))
                     (setq lst (cons
                                 (list e
                                       (caddr (assoc 10 (setq l (entget e))))
                                       (apply 'strcat
                                              (append (mapcar '(lambda (x)
                                                                 (if (vl-position (car x) '(1 3))
                                                                   (cdr x)
                                                                   ""
                                                                 )
                                                               )
                                                              l
                                                      )
                                                      '("\\P")
                                              )
                                       )
                                 )
                                 lst
                               )
                     )
                   )
                 )
               )
                (ssget "_:L" '((0 . "MTEXT,TEXT")))
                -1
              )
     )
   (vla-put-textstring
     (vlax-ename->vla-object (caar (setq ss (vl-sort ss '(lambda (a b) (> (cadr a) (cadr b)))))))
     (apply 'strcat
            (append (list (caddar ss))
                    (mapcar '(lambda (x) (entdel (car x)) (caddr x)) (cdr ss))
            )
     )
   )
 )
 (princ)
)