有哪位高手有实现两列文字合并的程序啊，不胜感激啊
有哪位高手有实现两列文字合并的程序啊，不胜感激啊 来源于网上 cad菜单expreee-text -convert text to mtext,打这个命令就可 先感谢下，不过都不是我想要的，可能是我描述的不清楚吧：是两列文字合并，文字在表格内，每一列有多个文字，合并为新的一列，这一列的text数目和之前的一样，详见附件 本帖最后由 langjs 于 2012-11-8 23:37 编辑;;文字合并 by：langjs
(defun c:aa (/ e1 e2 ent i j lst1 lst2 p pt ss)
(setq lst1 '()lst2 '()
)
(setvar "nomutt" 1)
(princ "\n选择第一列文本:")
(if (setq ss (ssget '((0 . "*TEXT"))))
(repeat (setq i (sslength ss))
(setq ent (entget (ssname ss (setq i (1- i))))
lst1 (cons (list (cdr (assoc 10 ent)) (cdr (assoc 1 ent))) lst1))
))
(princ "\n选择第二列文本:")
(if (setq ss (ssget '((0 . "*TEXT"))))
(repeat (setq i (sslength ss))
(setq ent (entget (ssname ss (setq i (1- i))))
lst2 (cons (list (cdr (assoc 10 ent)) (cdr (assoc 1 ent))) lst2))
))
(setvar "nomutt" 0)
(setq ent (cdr ent)
lst1 (vl-sort lst1 (function (lambda (e1 e2)(> (cadr (car e1)) (cadr (car e2))))))
lst2 (vl-sort lst2 (function (lambda (e1 e2)(> (cadr (car e1)) (cadr (car e2))))))
pt (getpoint "\n指定合并文字插入点:")
)
(if (< (length lst1) (setq j (length lst2)))(setq j (length lst1)))
(setq i -1)
(repeat j
(setq p (list (car pt) (cadr (car (nth (setq i (1+ i)) lst1 ))))
ent (subst(cons 10 p)(assoc 10 ent)ent))
(entmake (subst (cons 1 (strcat (cadr (nth i lst1)) (cadr (nth i lst2))))(assoc 1 ent) ent))
)
(princ)
)
非常感谢楼主langjs，这正是我需要的 langjs大师，还有个问题，程序运行后，不管选择点在那，合并的文字都在一个位置上，还请帮忙修改下啊 知道了，主要是我这文字是居中对齐的，改成左对齐就可以了，再次感谢langjs
非常感谢楼主langjs，找了好久终于找到。如果要把结果替换到第三列如何修改
页:
[1]