【求助】单行文字转多行文字

iszc

http://bbs.mjtd.com/forum.php?mo ... &fromuid=404098

此楼为最佳答案，上面因楼层看错误选，在此表示歉意
特别感谢 llsheng_73 帮忙

偏爱云~小吴

(defun C:test (/ EN ENT LST LST1 OLDAUN OLDOSM PT SS STR TXT ZG)
  (setq oldaun (getvar "aunits")
oldosm (getvar "osmode"))
  (setvar "aunits" 3)   ;设为弧度
  (setvar "osmode" 0 )                   ;设为无捕捉方式
  (setq ss (ssget '((0 . "TEXT"))))
   (if (not ss)                     ;图中没有插入各种符号
    (progn (alert " 没有选中文本")
           (exit))
    (progn
      (while (> (sslength ss) 0)
(setq ent (entget(setq en (ssname ss 0))));取出第一个数据
(setq pt (cdr(assoc 10 ent))
      txt (cdr(assoc 1 ent))
      zg (cdr(assoc 40 ent))
      lst (cons (list pt txt zg) lst);;获取表
      ss (ssdel en ss))
(entdel  en));删除图元
      (setq lst1 (vl-sort lst
         (function (lambda (e1 e2)
                (< (cadr(car e1)) (cadr(car e2))) ) ) ));根据y坐标排序
      (setq str "")
      (foreach e lst1
(setq str (strcat (cadr e) "\n" str))
(setq pt (car e);插入点
    zg (caddr e)));字高
      (setq pt (polar pt (* pi 0.5) zg))
      (vl-cmdf "MTEXT" pt "H" zg "W" 0 (substr str 1 (1- (strlen str))) "")))
  (setvar "aunits" oldaun)   ;设为弧度
  (setvar "osmode" oldosm )
  (princ)
  )

偏爱云~小吴

弱弱的问下大神们，有批量让框里的坐标转多行的么，在上面的基础上怎么改见附file:///c:/documents and settings/administrator/application data/360se6/User Data/Temp/forum.php?mod=attachment&aid=ODAwMjN8ZTY3MDNhYzZ8MTM4NDIyOTUwN3w3Mjk5OTkxfDEwODIzOA%3D%3D&noupdate=yes件

ljxkm

iszc 发表于 2013-11-9 14:49
不好意思，加载错误

下载了tmp1.lsp,按提示操作，最后为((0 . "MTEXT") (100 . "AcDbEntity") (100 . "AcDbMText") (10
271228.0 8558.65 0.0) (40 . 4.5) (41 . 472.5) (1 . "   
上覆第四系坡崩季砂岩土，硬塑~软塑状夹块碎石，角砾残积砂土，硬塑~半干硬状，局部为
软塑状，含5~20%砂，\\P泥质岩块碎石角砾。下伏三叠系上统火把冲组泥质砂岩，中细粒石
英砂岩，泥质岩互层，夹0.2~0.4米厚劣质煤，节理发\\P育，表层风化严重~极严重，受区
域构造影响，岩层产状多变，K536+811.68附近有一断层发育，其破碎带宽30~50\\P米，由
砂岩、泥质岩角砾组成，局部为断泥层，该隧道地下水量12572m(3)/d，其中K537+266.68~+
404.68段水量\\P较大，K537+344.68处线路左侧有股流，其水量达9672m(3)/d；地下水无侵
蚀性，该隧道中部有少量瓦斯溢出，并在\\P洞室内聚集。地震动峰值加速度为0.05g，地震
动反应谱特征周期为0.45s。") (7 . "sdhz") (71 . 1) (73 . 1))
但什么也没生成，不知什么原因

ljxkm

可能是图纸的坐标系统问题，好用的，谢了啊

q3_2006

偏爱云~小吴 发表于 2013-11-12 12:13
(defun C:test (/ EN ENT LST LST1 OLDAUN OLDOSM PT SS STR TXT ZG)
  (setq oldaun (getvar "aunits")
...

2. (defun tt (ss / EN ENT LST LST1 OLDAUN OLDOSM PT SS STR TXT ZG)
   
3.   (setq oldaun (getvar "aunits")
   
4. oldosm (getvar "osmode"))
   
5.   (setvar "aunits" 3)   ;设为弧度
   
6.   (setvar "osmode" 0 )                   ;设为无捕捉方式
   
7.    (if (not ss)                     ;图中没有插入各种符号
   
8.     (progn (alert " 没有选中文本")
   
9.            (exit))
   
10.     (progn
    
11.       (while (> (sslength ss) 0)
    
12. (setq ent (entget(setq en (ssname ss 0))));取出第一个数据
    
13. (setq pt (cdr(assoc 10 ent))
    
14.       txt (cdr(assoc 1 ent))
    
15.       zg (cdr(assoc 40 ent))
    
16.       lst (cons (list pt txt zg) lst);;获取表
    
17.       ss (ssdel en ss))
    
18. (entdel  en));删除图元
    
19.       (setq lst1 (vl-sort lst
    
20.          (function (lambda (e1 e2)
    
21.                 (< (cadr(car e1)) (cadr(car e2))) ) ) ));根据y坐标排序
    
22.       (setq str "")
    
23.       (foreach e lst1
    
24. (setq str (strcat (cadr e) "\n" str))
    
25. (setq pt (car e);插入点
    
26.     zg (caddr e)));字高
    
27.       (setq pt (polar pt (* pi 0.5) zg))
    
28.       (vl-cmdf "MTEXT" pt "H" zg "W" 0 (substr str 1 (1- (strlen str))) "")))
    
29.   (setvar "aunits" oldaun)   ;设为弧度
    
30.   (setvar "osmode" oldosm )
    
31.   (princ)
    
32.   )
    
33.   (defun ss2lst (ss / lst n ssnamen)
    
34.   (setq n -1
    
35. lst '()
    
36.   )
    
37.   (while (setq ssnamen (ssname ss (setq n (1+ n))))
    
38.     (setq lst (cons ssnamen lst))
    
39.   )
    
40.   (reverse lst)
    
41. )
    
42.   (defun c:t0 ( / lst p1 p2 pn s1 ss ss0)
    
43.   (vl-load-com)
    
44.   (setq ss (ssget '((0 . "LWPOLYLINE")))
    
45.         lst (ss2lst ss)
    
46.   )
    
47.   (foreach s1 lst
    
48.     (setq pn (vlax-get (vlax-ename->vla-object s1) 'coordinates)
    
49.           p1 (list (nth 0 pn) (nth 1 pn))
    
50.           p2 (list (nth 4 pn) (nth 5 pn))
    
51.           ss0 (ssget "c" p1 p2 '((0 . "*TEXT")))
    
52.     )
    
53.     (tt ss0)
    
54.   )
    
55. )

(defun tt (ss / EN ENT LST LST1 OLDAUN OLDOSM PT SS STR TXT ZG)<br />   (setq oldaun (getvar "aunits")<br /> oldosm (getvar "osmode"))<br />   (setvar "aunits" 3)   ;设为弧度<br />   (setvar "osmode" 0 )                   ;设为无捕捉方式<br />    (if (not ss)                     ;图中没有插入各种符号<br />     (progn (alert " 没有选中文本")<br />            (exit))<br />     (progn<br />       (while (> (sslength ss) 0)<br /> (setq ent (entget(setq en (ssname ss 0))));取出第一个数据<br /> (setq pt (cdr(assoc 10 ent))<br />       txt (cdr(assoc 1 ent))<br />       zg (cdr(assoc 40 ent))<br />       lst (cons (list pt txt zg) lst);;获取表<br />       ss (ssdel en ss))<br /> (entdel  en));删除图元<br />       (setq lst1 (vl-sort lst<br />          (function (lambda (e1 e2)<br />                 (< (cadr(car e1)) (cadr(car e2))) ) ) ));根据y坐标排序<br />       (setq str "")<br />       (foreach e lst1<br /> (setq str (strcat (cadr e) "\n" str))<br /> (setq pt (car e);插入点<br />     zg (caddr e)));字高<br />       (setq pt (polar pt (* pi 0.5) zg))<br />       (vl-cmdf "MTEXT" pt "H" zg "W" 0 (substr str 1 (1- (strlen str))) "")))<br />   (setvar "aunits" oldaun)   ;设为弧度<br />   (setvar "osmode" oldosm )<br />   (princ)<br />   )<br />   (defun ss2lst (ss / lst n ssnamen)<br />   (setq n -1<br /> lst '()<br />   )<br />   (while (setq ssnamen (ssname ss (setq n (1+ n))))<br />     (setq lst (cons ssnamen lst))<br />   )<br />   (reverse lst)<br /> )<br />   (defun c:t0 ( / lst p1 p2 pn s1 ss ss0)<br />   (vl-load-com)<br />   (setq ss (ssget '((0 . "LWPOLYLINE")))<br />         lst (ss2lst ss)<br />   )<br />   (foreach s1 lst<br />     (setq pn (vlax-get (vlax-ename->vla-object s1) 'coordinates)<br />           p1 (list (nth 0 pn) (nth 1 pn))<br />           p2 (list (nth 4 pn) (nth 5 pn))<br />           ss0 (ssget "c" p1 p2 '((0 . "*TEXT")))<br />     )<br />     (tt ss0)<br />   )<br /> )

依然小小鸟

llsheng_73 发表于 2013-11-9 15:46
其实程序很简单，关键就在排序上，最后我直接用了你分享的通用排序函数

还能增加一个功能吗  生成多行文字后 增加一个选项 是否删除源对象

linque06

很好用，比我常用 的插件ZDM里tmt命令还好用。

glcsq

谢谢分享。