文字合并，按鼠标右键增加空格
;;;合并文本内容(defun C:TJ (/ SS ENT STR I)
(if (and (setq SS (ssget '((0 . "*TEXT"))))
(>= (sslength SS) 2)
)
(progn
;;获得第一个对象的内容
(setq ENT (entget (ssname SS 0))
STR (cdr (assoc 1 ENT))
)
;;获得其他对象的内容并依次连接
(setq I 1)
(repeat (1- (sslength SS))
(setq STR (strcat STR
(cdr (assoc 1 (entget (ssname SS I))))
)
I (1+ I)
)
)
;;更新第一个对象内容
(setq ENT
(subst (cons 1 STR)
(assoc 1 ENT)
ENT
)
)
(entmod ENT)
)
)
(command "_.erase" ss "remove" (ssname SS 0) "")
(princ)
);_结束defun
这是一个合并文字的程序，请高手完善一下，增加一个选项，按鼠标左键正常合并，按鼠标右键让合并文字之间加一个空格 这个应该不难啊，怎么没有高人出手啊，自顶一下 这个要是写好了应该挺难的吧，我也一直想要这么一个程序，我的思路是这样，1、把所有的文字打散成单个字符，放入选择集ss1中。2、对每一个字符进行缩放使之在视口内，用textbox求出单字轮廓（中间需要用坐标变换，以适应ucs）。3、用单字轮廓对左右进行扩选，扩选距离使用户可以设置，对选中的文字放入选择集SS2中，并从SS1中删除。4、对成组选择的文字时行合并成一个单行文字。如此循复，最终可成。 ;;;合并文本内容
(defun C:TJ (/ SS ENT STR I)
(if (and (setq SS (ssget '((0 . "*TEXT"))))
(>= (sslength SS) 2)
)
(progn
;;获得第一个对象的内容
(setq p (getpoint "\n加空格（鼠标左键）/不加空格<鼠标右键>:"))
(if p (setq str1 " ")(setq str1 ""))
(setq ENT (entget (ssname SS 0))
STR (cdr (assoc 1 ENT))
)
;;获得其他对象的内容并依次连接
(setq I 1)
(repeat (1- (sslength SS))
(setq STR (strcat STR str1
(cdr (assoc 1 (entget (ssname SS I))))
)
I (1+ I)
)
)
;;更新第一个对象内容
(setq ENT
(subst (cons 1 STR)
(assoc 1 ENT)
ENT
)
)
(entmod ENT)
)
)
(command "_.erase" ss "remove" (ssname SS 0) "")
(princ)
);_结束defun
已经在高手的指导下完成了 szx025 发表于 2014-9-3 08:53 static/image/common/back.gif
;;;合并文本内容
(defun C:TJ (/ SS ENT STR I)
程序真心好，不过就是撤消的时候(Ctrl+z)，有些小问题 写的不错哈
谢谢! szx025 分享程序!!!!! 好用的很，正好梁集中标注修改派上用处！ 好用的很，正好梁集中标注修改派上用处！
页:
[1]
2