本帖最后由 荒野孤行 于 2016-1-24 20:30 编辑
回复才可见隐藏的源码哦！如下：
;;;*****文字合并 程序开始*****
(defun c:hb (/ 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)
)
;;;*****文字合并 程序结束*****
程序执行后的效果请见图片演示：
网友答: 多谢分享，我自己写的某个程序在使用时存在提取一个区域里的文本有多个的问题，这个刚好解决了我的问题，赞！网友答: 搂主可以按你这个方式做个拆分的源码吗？我相信一定很实用。我先给你支持下。网友答: 感谢分享！网友答: 谢谢分享，下载试试看网友答: 多谢分享，学习学习网友答:
很好，谢谢留住分享网友答:
这个很不错啊，必须支持下网友答:
谢谢楼主，这下可以把哪些散碎的文字合并了
网友答: 感谢分享,下来试试网友答: 谢谢分享，！！！！网友答: 多谢分享，学习学习
回复才可见隐藏的源码哦！如下：
;;;*****文字合并 程序开始*****
(defun c:hb (/ 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)
)
;;;*****文字合并 程序结束*****
程序执行后的效果请见图片演示：
网友答: 多谢分享，我自己写的某个程序在使用时存在提取一个区域里的文本有多个的问题，这个刚好解决了我的问题，赞！网友答: 搂主可以按你这个方式做个拆分的源码吗？我相信一定很实用。我先给你支持下。网友答: 感谢分享！网友答: 谢谢分享，下载试试看网友答: 多谢分享，学习学习网友答:
很好，谢谢留住分享网友答:
这个很不错啊，必须支持下网友答:
谢谢楼主，这下可以把哪些散碎的文字合并了网友答: 感谢分享,下来试试网友答: 谢谢分享，！！！！网友答: 多谢分享，学习学习