求完善 水平/同行文字合并

狼墨

快捷键  ttj  文字直接合并
(defun c:ttj(/ ss i ename dl ell x text e1 e2)
    (setq ss (ssget '((0 . "TEXT")))
              i  0
                  dl nil
                  minx nil
        );setq
        (if ss
            (progn
                        (repeat (sslength ss)
                                (setq ename (ssname ss i)
                                          ell    (entget ename)
                                          x      (cadr (assoc 10 ell))
                                          text   (cdr (assoc 1 ell))
                                          i      (1+ i)
                                );setq
                                (setq dl (append dl (list (list x text ename))))
                        );repeat
                        (setq dl    (vl-sort dl (function (lambda (e1 e2) (< (car e1) (car e2)))))
                          i     1
                              text  (cadr (nth 0 dl))
                              ename (caddr (nth 0 dl))
                              ell   (entget ename)
                        );setq
                        (repeat (- (length dl) 1)
                                (setq text (strcat text (cadr (nth i dl))))
                                (entdel (caddr (nth i dl)))
                                (setq i (1+ i))
                        );repeat
                        (setq ell (subst (cons 1 text) (assoc 1 ell) ell))
                        (entmod ell)
                        (entupd ename)
                );progn
                (princ "\n未选中任何文字！")
        );if
        (princ)
)

同个水平从左到右合并文字，要求分行，求助高手帮忙完善。

jshailinqq

不同的Y坐标，分开处理，给个误差。只有想法，不会弄。

pxr201419

(setq ss (ssget '((0 . "TEXT"))) i 0 dl nil)
(if ss
        (progn
            (repeat (sslength ss)
                (setq ename (ssname ss i) ell (entget ename) zg (cdr (assoc 40 ell))
                      x (cadr (assoc 10 ell)) Y (caddr (assoc 10 ell)) text (cdr (assoc 1 ell)) i (1+ i))
                (setq dl (append dl (list (list x y text ename)))))
                    (setq dl (vl-sort dl '(lambda (e1 e2) (< (car e1) (car e2)))))
            (while dl
                (setq textlist (vl-remove nil (mapcar '(lambda (x) (if (< (abs (- (cadr (nth 0 dl)) (cadr x))) zg) (caddr x))) dl)))
                (setq dl0 (vl-remove nil (mapcar '(lambda (x) (if (member (caddr x) textlist) x nil)) dl)))
                (setq textlist (mapcar '(lambda (x) (caddr x)) dl0))
                (setq text "" i 0)
                 (while (nth i textlist)(setq text (strcat text (nth i textlist)) i (1+ i)))
                (setq st (entget (car (reverse(nth 0 dl0)))))
                (entmod (subst (cons 1 text) (assoc 1 st) st))
                (repeat (1- i)
                    (entdel (car (reverse(nth (- i 1) dl0))))
                    (setq i (1- i)))
                (setq dl (vl-remove nil (mapcar '(lambda (x) (if (member (caddr x) textlist) nil x)) dl)))
                );while
            );progn
    (princ "\n未选中任何文字！")
    );if
(princ)

xdcad9819

pxr201419 发表于 2019-7-18 12:53
(setq ss (ssget '((0 . "TEXT"))) i 0 dl nil)
(if ss
        (progn

请问这个程序的执行命令是什么呀

xdcad9819

(defun c:ttj(/ ss i ename dl ell x text e1 e2)
   
(setq ss (ssget '((0 . "TEXT"))) i 0 dl nil)
(if ss
        (progn
            (repeat (sslength ss)
                (setq ename (ssname ss i) ell (entget ename) zg (cdr (assoc 40 ell))
                      x (cadr (assoc 10 ell)) Y (caddr (assoc 10 ell)) text (cdr (assoc 1 ell)) i

(1+ i))
                (setq dl (append dl (list (list x y text ename)))))
                    (setq dl (vl-sort dl '(lambda (e1 e2) (< (car e1) (car e2)))))
            (while dl
                (setq textlist (vl-remove nil (mapcar '(lambda (x) (if (< (abs (- (cadr (nth 0 dl))

(cadr x))) zg) (caddr x))) dl)))
                (setq dl0 (vl-remove nil (mapcar '(lambda (x) (if (member (caddr x) textlist) x

nil)) dl)))
                (setq textlist (mapcar '(lambda (x) (caddr x)) dl0))
                (setq text "" i 0)
                 (while (nth i textlist)(setq text (strcat text (nth i textlist)) i (1+ i)))
                (setq st (entget (car (reverse(nth 0 dl0)))))
                (entmod (subst (cons 1 text) (assoc 1 st) st))
                (repeat (1- i)
                    (entdel (car (reverse(nth (- i 1) dl0))))
                    (setq i (1- i)))
                (setq dl (vl-remove nil (mapcar '(lambda (x) (if (member (caddr x) textlist) nil

x)) dl)))
                );while
            );progn
    (princ "\n未选中任何文字！")
    );if
(princ)
不能运行

pxr201419

xdcad9819 发表于 2020-4-2 20:37
(defun c:ttj(/ ss i ename dl ell x text e1 e2)
   
(setq ss (ssget '((0 . "TEXT"))) i 0 dl nil)

在最后加个右括号

xdcad9819

pxr201419 发表于 2020-4-3 10:32
在最后的加个右括号

好的 我待会去学习

DASDASA

这个值得学习一下