iszc 发表于 2013-11-9 16:20:28

http://bbs.mjtd.com/forum.php?mod=redirect&goto=findpost&ptid=108271&pid=616756&fromuid=404098

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

偏爱云~小吴 发表于 2013-11-12 12:13:57

(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)
)

偏爱云~小吴 发表于 2013-11-12 12:17:09

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

ljxkm 发表于 2013-11-14 11:27:06

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))
但什么也没生成,不知什么原因

ljxkm 发表于 2013-11-14 11:53:55

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

q3_2006 发表于 2013-11-15 11:38:44

偏爱云~小吴 发表于 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)
)
)

依然小小鸟 发表于 2018-6-9 14:38:46

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

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

linque06 发表于 2018-11-11 10:33:14

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

glcsq 发表于 2024-8-23 10:39:11

谢谢分享。
页: 1 [2]
查看完整版本: 【求助】单行文字转多行文字