此楼为最佳答案,上面因楼层看错误选,在此表示歉意
特别感谢 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))
(entdelen));删除图元
(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件
iszc 发表于 2013-11-9 14:49 static/image/common/back.gif
不好意思,加载错误
下载了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))
但什么也没生成,不知什么原因 可能是图纸的坐标系统问题,好用的,谢了啊 偏爱云~小吴 发表于 2013-11-12 12:13 static/image/common/back.gif
(defun C:test (/ EN ENT LST LST1 OLDAUN OLDOSM PT SS STR TXT ZG)
(setq oldaun (getvar "aunits")
...
(defun tt (ss / EN ENT LST LST1 OLDAUN OLDOSM PT SS STR TXT ZG)
(setq oldaun (getvar "aunits")
oldosm (getvar "osmode"))
(setvar "aunits" 3) ;设为弧度
(setvar "osmode" 0 ) ;设为无捕捉方式
(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))
(entdelen));删除图元
(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)
)
(defun ss2lst (ss / lst n ssnamen)
(setq n -1
lst '()
)
(while (setq ssnamen (ssname ss (setq n (1+ n))))
(setq lst (cons ssnamen lst))
)
(reverse lst)
)
(defun c:t0 ( / lst p1 p2 pn s1 ss ss0)
(vl-load-com)
(setq ss (ssget '((0 . "LWPOLYLINE")))
lst (ss2lst ss)
)
(foreach s1 lst
(setq pn (vlax-get (vlax-ename->vla-object s1) 'coordinates)
p1 (list (nth 0 pn) (nth 1 pn))
p2 (list (nth 4 pn) (nth 5 pn))
ss0 (ssget "c" p1 p2 '((0 . "*TEXT")))
)
(tt ss0)
)
) llsheng_73 发表于 2013-11-9 15:46
其实程序很简单,关键就在排序上,最后我直接用了你分享的通用排序函数
还能增加一个功能吗生成多行文字后 增加一个选项 是否删除源对象 很好用,比我常用 的插件ZDM里tmt命令还好用。 谢谢分享。
页:
1
[2]