尘缘一生 发表于 2022-11-17 19:40:28

求一段LISP源码（MTEXT查找定位）

本帖最后由 尘缘一生 于 2022-11-17 20:21 编辑



以上图示，为MTEXT多行字，其中包含“张三”三处
代码找到它，和它的中心坐标，输出一个表
(（张三 pt1) (张三 pt2) (张三pt3))

想炸开的想法不在此列，禁言！

sto111 发表于 2022-11-19 04:15:37

(defun c:hqwbxx (/ xzj xzjshl i ty tylb wbnr wnxy 10xy 11xy 72dq 73dq mbwbj wjmch mbwb str)
(princ "\n选择待提取信息的文本：")


(setq xzj (ssget '((0 . "MTEXT")))
          xzjshl (sslength xzj))


(setq i 0)
(repreat xzjshl
   (setq ty    (ssname xzj i)
             tybl(entget ty)
             wbnr (cdr (assoc 1 tylb))
             10xy (cdr (assoc 10 tylb))
             11xy (cdr (assoc 11 tylb))
             72dq (cdr (assoc 72 tylb))
             73dq (cdr (assoc 73 tylb)))

   (if (wcmatch wbnr "*张三*")
      (progn
            (cond ( (and (= 72dq 0) (= 73dq 0)) (setq wbxy 10xy) )
                     ( t (setq wbxy 11xy) )
             )

             (setq mbwbj (cons (list wbnr wbxy) mbwbj))
       ) )

      (setq i (1+ i))
   )

   (setq wjmch (getfiled "" "" "txt" 1)
         wjmch (open wjmch "w"))

   (foreach mbwb mbwbj
   (setq wbnr (car mbwb)
             wbxy (cadr mbwb))
   (setq str (strcat wbnr "," (rtos (car wbxy) 2 3) "," (rtos (cadr wbxy) 2 3)))
   (write-line str wjmch)
)

(alert "写入文件成功！")
)

这是我即兴编写的，没有调试过，你试试看看，不行的话，你修改一下。

尘缘一生 发表于 2022-11-19 20:29:10

本帖最后由 尘缘一生 于 2022-11-19 20:32 编辑

sto111 发表于 2022-11-19 04:15
(defun c:hqwbxx (/ xzj xzjshl i ty tylb wbnr wnxy 10xy 11xy 72dq 73dq mbwbj wjmch mbwb str)
(prin ...
代码经过测试，不是这个意思，你这个对于单行的可以，
主要是，对于一大篇的MTEXT , 对其中特定字符，取得它的位置和字符串。


[*];;---------------c:hqwbxx
[*](defun c:tt () ;(/ xzj xzjshl i ty tybl wbnr wnxy 10xy 11xy 72dq 73dq mbwbj wjmch mbwb str)
[*](princ "\n 选择待提取信息的文本：")
[*](setq xzj (ssget '((0 . "MTEXT"))) xzjshl (sslength xzj))
[*](setq i 0)
[*](repeat xzjshl
[*]    (setq
[*]      ty (ssname xzj i)
[*]      tybl (entget ty)
[*]      wbnr (cdr (assoc 1 tybl))
[*]      10xy (cdr (assoc 10 tybl))
[*]      11xy (cdr (assoc 11 tybl))
[*]      72dq (cdr (assoc 72 tybl))
[*]      73dq (cdr (assoc 73 tybl)))
[*]    (if (wcmatch wbnr "*张三*")
[*]      (progn
[*]      (cond
[*]          ((and (= 72dq 0) (= 73dq 0))
[*]            (setq wbxy 10xy)
[*]          )
[*]          (t (setq wbxy 11xy))
[*]      )
[*]      (setq mbwbj (cons (list wbnr wbxy) mbwbj))
[*]      )
[*]    )
[*]    (setq i (1+ i))
[*])
[*](setq wjmch (getfiled "" "" "txt" 1) wjmch (open wjmch "w"))
[*](foreach mbwb mbwbj
[*]    (setq wbnr (car mbwb) wbxy (cadr mbwb))
[*]    (setq str (strcat wbnr "," (rtos (car wbxy) 2 3) "," (rtos (cadr wbxy) 2 3)))
[*]    (write-line str wjmch)
[*])
[*](close wjmch)
[*](alert "写入文件成功！")
[*] mbwbj
[*])


我目前，还是采取：炸开-取得-再还原MTEXT


尘缘一生 发表于 2022-11-20 05:25:51

sto111 发表于 2022-11-19 22:33
你需要的坐标是张三的中心坐标，还是它的插入坐标啊？
如果是中心坐标，可以使用textbox这个函数

插入坐标，中心点，都可以，关键是多行MTEXT如何找，根据上面黄大师说的，实际也是有办法的，只是，很难精确。

wzg356 发表于 2022-11-17 19:52:20

搜索学习entget，wcmatch代码案例，对照群码表，

xiangganglv 发表于 2022-11-17 19:58:06

你这截图让整个论坛都岌岌可危，建议删了。

liuhe 发表于 2022-11-18 08:36:35

xiangganglv 发表于 2022-11-17 19:58
你这截图让整个论坛都岌岌可危，建议删了。

哈哈6666666666666666

wosiguwozai0830 发表于 2022-11-18 08:48:05

http://bbs.mjtd.com/forum.php?mod=viewthread&tid=91554&highlight=%B2%E9%D5%D2&_dsign=aff0107a，这里面应该有你需要的

骑着蜗牛旅行666 发表于 2022-11-18 09:53:00

http://bbs.mjtd.com/forum.php?mod=viewthread&tid=175593&highlight=%B2%E9%D5%D2&_dsign=这里面应该有你需要的

xyp1964 发表于 2022-11-18 13:18:44


正能量的一诺 发表于 2022-11-18 16:20:39

xyp1964 发表于 2022-11-18 13:18


院长就是终结者
页: [1] 2
查看完整版本: 求一段LISP源码（MTEXT查找定位）