【求助】单行文字转多行文字
本帖最后由 iszc 于 2013-11-8 23:11 编辑帮忙写个lsp
如图，将单行文字合并为多行文字，要求合并后按照从左至右的顺序排序
;;这个问题，好象本论坛很多的嘛
;;下面是我下载，谁写的不记得了，敬请原谅
(defun TextToMText
(/ BLST BOX BOXL E EL H L N OLDH OLDST PY SS SSL ST STRL X)
(if (setq ss (ssget '((0 . "text"))))
(progn
(setq
ssl (sslength ss)
n -1
oldh (getvar "textsize")
oldst (getvar "textstyle")
)
(repeat ssl
(setq
e (ssname ss (setq n (1+ n)))
el (entget e)
box (textbox (vl-remove (assoc 50 el) el))
boxl (cons box boxl)
l (+ (abs (caadr box)) (abs (cadadr box)))
blst (cons l blst)
strl (cons
(list (cdr (assoc 10 el)) (cdr (assoc 1 el)))
strl
)
h (if (and h (> (cdr (assoc 40 el)) h))
(setq h (cdr (assoc 40 el)))
(setq h (cdr (assoc 40 el)))
)
st (if (not st)
(cdr (assoc 7 el))
st
)
)
)
(setvar "textsize" h)
(if (/= (getvar "textstyle") st)
(setvar "textstyle" st)
)
(setq
strl (vl-sort strl
'(lambda (e1 e2)
(if (equal (cadar e1) (cadar e2) 0.00001)
(< (caar e1) (caar e2))
(> (cadar e1) (cadar e2))
)
)
)
py (apply 'max (mapcar 'cadr (apply 'append boxl)))
)
(vla-addmtext
(vla-get-modelspace
(vla-get-activedocument
(vlax-get-acad-object)
)
)
(vlax-3d-point
(list (caaar strl) (+ py (cadaar strl)))
)
(apply 'max blst)
(apply 'strcat
(mapcar
'(lambda (x)
(strcat (last x) "\\P")
)
strl
)
)
)
(command ".erase" ss "")
(setvar "textsize" oldh)
(setvar "textstyle" oldst)
)
)
)
;;1.2 Mtext转text
(defun MtextToText (/ EN N SS)
(setq ss (ssget (list (cons 0 "MTEXT"))))
(if ss
(repeat (setq n (sslength ss))
(setq en (ssname ss (setq n (1- n))))
(command "_.explode" en)
)
)
) 本帖最后由 llsheng_73 于 2013-11-9 15:44 编辑
(defun c:tt(/ s1 t2 sstoes p b l);;用了自贡黄明儒的通用排序函数
(defun SstoEs(ss / a en lst)
(if ss(progn(setq a -1)
(while(setq en(ssname ss(setq a(1+ a))))(setq lst (cons en lst)))))
lst);defun end
(defun ssPtsSort(ssPts KEY FUZZ / E EN FUN LST N SORTPTS SORTSS);;by自贡黄明儒 2013年9月9日
(defun sortpts (PTS FUN xyz FUZZ)
(vl-sort pts'(lambda (a b)(if(not(equal(xyz a)(xyz b)fuzz))(fun(xyz a)(xyz b)))))
)
(defun sortpts1 (PTS KEY FUZZ)
(setq Key (vl-string->list Key))
(foreach xyz (reverse Key)
(cond ((< xyz 100)
(setq fun >
xyz(nth(- xyz 88)(list car cadr caddr))))
(T(setq fun <
xyz(nth(- xyz 120)(list car cadr caddr)))))
(setq Pts(sortpts Pts fun xyz fuzz)))
)
(cond((=(type ssPts)'PICKSET)
(repeat(setq n(sslength ssPts))
(if(and(setq e(ssname ssPts(setq n(1- n))))
(setq en(entget e)))
(setq lst (cons (append (cdr (assoc 10 en)) (list e)) lst))))
(mapcar 'last (sortpts1 lst KEY FUZZ)))
((Listp ssPts)(cond ((vl-consp (car ssPts)) (sortpts1 ssPts KEY FUZZ))
((= (type (car ssPts)) 'ENAME)
(foreach e ssPts(if(setq en(entget e))(setq lst(cons(append(cdr(assoc 10 en))(list e))lst))))
(mapcar'last(sortpts1 lst KEY FUZZ)))))
)
);defun end
(prompt "请选择要合并为多行文本的单行文字对象")
(setq s1(SstoEs(ssget'((0 . "TEXT"))))T2"")
(if s1(progn
(setq s1 (ssPtsSort s1 "Yx" 0.5)
b(entget(car s1))
t2(cdr(assoc 1 b))l 1)
(foreach a(cdr s1)(setq c(cdr(assoc 1(entget a)))l(if(>(strlen c)l)(strlen c)l)t2(strcat t2"\\P"c)))
(while(null(setq p(getpoint"指定多行文本左上角点"))))
(entmake(list(cons 0 "MTEXT")(cons 100 "AcDbEntity")(cons 100"AcDbMText")(cons 10 P)(assoc 40 b)
(cons 41 (* l (cdr(assoc 40 b))))(cons 1 t2)(assoc 7 b)(cons 71 1)(cons 73 1)))))
)
还是老黄的通用排序强大!!!
已经按你说的作了点小修改，附件也更新了。。。 llsheng_73 发表于 2013-11-9 13:08 static/image/common/back.gif
已经按你说的作了点小修改，附件也更新了。。。
测试还是不理想 如图
自贡黄明儒 发表于 2013-11-9 14:40 static/image/common/back.gif
;;这个问题，好象本论坛很多的嘛
;;下面是我下载，谁写的不记得了，敬请原谅
不好意思，加载错误 iszc 发表于 2013-11-9 14:49 static/image/common/back.gif
不好意思，加载错误
已成功加载 合并单行文字1.lsp
命令: ; 错误: *error* 函数中出错参数类型错误: lselsetp nil 自贡黄明儒 发表于 2013-11-9 14:40 static/image/common/back.gif
;;这个问题，好象本论坛很多的嘛
;;下面是我下载，谁写的不记得了，敬请原谅
其实程序很简单，关键就在排序上，最后我直接用了你分享的通用排序函数 自贡黄明儒 发表于 2013-11-9 14:40 static/image/common/back.gif
;;这个问题，好象本论坛很多的嘛
;;下面是我下载，谁写的不记得了，敬请原谅
MTEXT->TEXT直接EXPLODE？记得好象有时会多一些控制字符在单行文本里边 二位确实很厉害，谢谢帮忙
页:
[1]
2