明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 5461|回复: 17

[已解答] 【求助】单行文字转多行文字

[复制链接]
发表于 2013-11-8 22:54 | 显示全部楼层 |阅读模式
30明经币
本帖最后由 iszc 于 2013-11-8 23:11 编辑

帮忙写个lsp
如图,将单行文字合并为多行文字,要求合并后按照从左至右的顺序排序



附件: 您需要 登录 才可以下载或查看,没有账号?注册

最佳答案

查看完整内容

;;这个问题,好象本论坛很多的嘛 ;;下面是我下载,谁写的不记得了,敬请原谅
"觉得好,就打赏"
还没有人打赏,支持一下
发表于 2013-11-8 22:54 | 显示全部楼层
;;这个问题,好象本论坛很多的嘛
;;下面是我下载,谁写的不记得了,敬请原谅
  1. (defun TextToMText
  2.                      (/ BLST BOX BOXL E EL H L N OLDH OLDST PY SS SSL ST STRL X)
  3.     (if        (setq ss (ssget '((0 . "text"))))
  4.       (progn
  5.         (setq
  6.           ssl        (sslength ss)
  7.           n        -1
  8.           oldh        (getvar "textsize")
  9.           oldst        (getvar "textstyle")
  10.         )
  11.         (repeat        ssl
  12.           (setq
  13.             e         (ssname ss (setq n (1+ n)))
  14.             el         (entget e)
  15.             box         (textbox (vl-remove (assoc 50 el) el))
  16.             boxl (cons box boxl)
  17.             l         (+ (abs (caadr box)) (abs (cadadr box)))
  18.             blst (cons l blst)
  19.             strl (cons
  20.                    (list (cdr (assoc 10 el)) (cdr (assoc 1 el)))
  21.                    strl
  22.                  )
  23.             h         (if (and h (> (cdr (assoc 40 el)) h))
  24.                    (setq h (cdr (assoc 40 el)))
  25.                    (setq h (cdr (assoc 40 el)))
  26.                  )
  27.             st         (if (not st)
  28.                    (cdr (assoc 7 el))
  29.                    st
  30.                  )
  31.           )
  32.         )
  33.         (setvar "textsize" h)
  34.         (if (/= (getvar "textstyle") st)
  35.           (setvar "textstyle" st)
  36.         )
  37.         (setq
  38.           strl (vl-sort        strl
  39.                         '(lambda (e1 e2)
  40.                            (if (equal (cadar e1) (cadar e2) 0.00001)
  41.                              (< (caar e1) (caar e2))
  42.                              (> (cadar e1) (cadar e2))
  43.                            )
  44.                          )
  45.                )
  46.           py   (apply 'max (mapcar 'cadr (apply 'append boxl)))
  47.         )
  48.         (vla-addmtext
  49.           (vla-get-modelspace
  50.             (vla-get-activedocument
  51.               (vlax-get-acad-object)
  52.             )
  53.           )
  54.           (vlax-3d-point
  55.             (list (caaar strl) (+ py (cadaar strl)))
  56.           )
  57.           (apply 'max blst)
  58.           (apply 'strcat
  59.                  (mapcar
  60.                    '(lambda (x)
  61.                       (strcat (last x) "\\P")
  62.                     )
  63.                    strl
  64.                  )
  65.           )
  66.         )
  67.         (command ".erase" ss "")
  68.         (setvar "textsize" oldh)
  69.         (setvar "textstyle" oldst)
  70.       )
  71.     )
  72.   )

  73.   ;;1.2 Mtext转text
  74.   (defun MtextToText (/ EN N SS)
  75.     (setq ss (ssget (list (cons 0 "MTEXT"))))
  76.     (if        ss
  77.       (repeat (setq n (sslength ss))
  78.         (setq en (ssname ss (setq n (1- n))))
  79.         (command "_.explode" en)
  80.       )
  81.     )
  82.   )
回复

使用道具 举报

发表于 2013-11-9 01:14 | 显示全部楼层
本帖最后由 llsheng_73 于 2013-11-9 15:44 编辑

  1. (defun c:tt(/ s1 t2 sstoes p b l);;用了自贡黄明儒的通用排序函数
  2.   (defun SstoEs(ss / a en lst)
  3.     (if ss(progn(setq a -1)
  4.       (while(setq en(ssname ss(setq a(1+ a))))(setq lst (cons en lst)))))
  5.     lst);defun end
  6.   (defun ssPtsSort(ssPts KEY FUZZ / E EN FUN LST N SORTPTS SORTSS);;by自贡黄明儒 2013年9月9日
  7.     (defun sortpts (PTS FUN xyz FUZZ)
  8.       (vl-sort pts'(lambda (a b)(if(not(equal(xyz a)(xyz b)fuzz))(fun(xyz a)(xyz b)))))
  9.       )
  10.   (defun sortpts1 (PTS KEY FUZZ)
  11.     (setq Key (vl-string->list Key))
  12.      (foreach xyz (reverse Key)
  13.        (cond ((< xyz 100)
  14.        (setq fun >
  15.       xyz(nth(- xyz 88)(list car cadr caddr))))
  16.       (T(setq fun <
  17.        xyz(nth(- xyz 120)(list car cadr caddr)))))
  18.        (setq Pts(sortpts Pts fun xyz fuzz)))
  19.     )
  20.     (cond((=(type ssPts)'PICKSET)
  21.    (repeat(setq n(sslength ssPts))
  22.      (if(and(setq e(ssname ssPts(setq n(1- n))))
  23.      (setq en(entget e)))
  24.        (setq lst (cons (append (cdr (assoc 10 en)) (list e)) lst))))
  25.    (mapcar 'last (sortpts1 lst KEY FUZZ)))
  26.   ((Listp ssPts)(cond ((vl-consp (car ssPts)) (sortpts1 ssPts KEY FUZZ))
  27.         ((= (type (car ssPts)) 'ENAME)
  28.          (foreach e ssPts(if(setq en(entget e))(setq lst(cons(append(cdr(assoc 10 en))(list e))lst))))
  29.          (mapcar'last(sortpts1 lst KEY FUZZ)))))
  30.   )
  31.     );defun end
  32.   (prompt "请选择要合并为多行文本的单行文字对象")
  33.   (setq s1(SstoEs(ssget'((0 . "TEXT"))))T2"")
  34.   (if s1(progn
  35.     (setq s1 (ssPtsSort s1 "Yx" 0.5)
  36.    b(entget(car s1))
  37.    t2(cdr(assoc 1 b))l 1)
  38.     (foreach a(cdr s1)(setq c(cdr(assoc 1(entget a)))l(if(>(strlen c)l)(strlen c)l)t2(strcat t2"\\P"c)))
  39.     (while(null(setq p(getpoint"指定多行文本左上角点"))))
  40.     (entmake(list(cons 0 "MTEXT")(cons 100 "AcDbEntity")(cons 100  "AcDbMText")(cons 10 P)(assoc 40 b)
  41.            (cons 41 (* l (cdr(assoc 40 b))))(cons 1 t2)(assoc 7 b)(cons 71 1)(cons 73 1)))))
  42.   )


还是老黄的通用排序强大!!!


本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x

点评

测试效果很好,能够从左至右,不过顺序是先上下再左右,在多行情况下能先左右再上下依次排列 能不能麻烦再帮忙改下顺序,先左右再上下的排列顺序  发表于 2013-11-9 07:15

评分

参与人数 1明经币 +1 收起 理由
iszc + 1 真的很强大

查看全部评分

回复

使用道具 举报

发表于 2013-11-9 13:08 | 显示全部楼层
已经按你说的作了点小修改,附件也更新了。。。
回复

使用道具 举报

 楼主| 发表于 2013-11-9 14:25 | 显示全部楼层
llsheng_73 发表于 2013-11-9 13:08
已经按你说的作了点小修改,附件也更新了。。。

测试还是不理想 如图


本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
回复

使用道具 举报

 楼主| 发表于 2013-11-9 14:49 | 显示全部楼层
自贡黄明儒 发表于 2013-11-9 14:40
;;这个问题,好象本论坛很多的嘛
;;下面是我下载,谁写的不记得了,敬请原谅

不好意思,加载错误

点评

什么错误,我一直用得好好的?  发表于 2013-11-9 14:51
回复

使用道具 举报

 楼主| 发表于 2013-11-9 14:54 | 显示全部楼层
iszc 发表于 2013-11-9 14:49
不好意思,加载错误

已成功加载 合并单行文字1.lsp

命令: ; 错误: *error* 函数中出错参数类型错误: lselsetp nil

点评

会不会是少了加载这个 (vl-load-com)  发表于 2013-11-9 15:04
回复

使用道具 举报

发表于 2013-11-9 15:46 | 显示全部楼层
自贡黄明儒 发表于 2013-11-9 14:40
;;这个问题,好象本论坛很多的嘛
;;下面是我下载,谁写的不记得了,敬请原谅

其实程序很简单,关键就在排序上,最后我直接用了你分享的通用排序函数
回复

使用道具 举报

发表于 2013-11-9 15:50 | 显示全部楼层
自贡黄明儒 发表于 2013-11-9 14:40
;;这个问题,好象本论坛很多的嘛
;;下面是我下载,谁写的不记得了,敬请原谅

MTEXT->TEXT直接EXPLODE?记得好象有时会多一些控制字符在单行文本里边
回复

使用道具 举报

 楼主| 发表于 2013-11-9 15:52 | 显示全部楼层
二位确实很厉害,谢谢帮忙
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-3-29 13:26 , Processed in 0.192435 second(s), 32 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表