jh3030912 发表于 2023-8-4 12:05:52

寻求 批量查找特定文字 在其 文字上方加入 带序号前缀

例如以下数据   FM甲1021M2535   MM00   C5800   FC1058CC00

通过查找M和C(不区分大小写） 并且排除MM和CC

最终实现效果为    1#                2#                     3#          4#
                     FM甲1021      M2535    MM00   C5800      FC1058   CC00

有以下要求：
1、需要注意的是 查找的文字 可以是单行文字，多行文字，块内文字，天正文字等等
2、考虑到加入前缀后文字会变宽，接近文字可能会重叠，最好就是前缀和文字平行显示， 不要在一行显示。
例如不要显示为 （有时候会重叠）    1# FM甲10212#M2535MM00   3#C58004# FC1058   CC00
3、序号前缀可以设置字体 大小和颜色，便于区分

说明：其实CAD自带的查找 替换 可以简单实现，但是需要手工的一个个的加入 数字前缀，导致很繁琐。

vitalgg 发表于 2023-8-4 12:05:53

https://atlisp.cn/static/videos/文本上加编号.mp4


(defun check-text (ent / str)
(setq matchs '("*M*" "*C*"))
(setq notmatchs '("*MM*" "*CC*"))
(if (setq str (entity:getdxf ent 1))
      (and
       (apply 'or (mapcar '(lambda(x)(wcmatch (strcase str) x)) matchs))
       (apply 'and (mapcar '(lambda(x)(wcmatch (strcase str) (strcat "~" x))) notmatchs)))))

(defun findtext ()
(setq txts (pickset:to-list (ssget '((0 . "*text,attrib,insert")))))
(setq txts
(vl-remove-if-not
   '(lambda(txt)
   (cond
       ((/= "INSERT" (entity:getdxf txt 0))
      (check-text txt))
       ((= "INSERT" (entity:getdxf txt 0))
      (setq entlst (block:ent-list (entity:getdxf txt 2)))
      (setq flag nil)
      (while (and (setq ent (car entlst))
      (null flag))
    (if (wcmatch (entity:getdxf ent 0) "*TEXT")
      (setq flag
      (check-text ent)))
    (setq entlst (cdr entlst))
    )
      flag)))
   txts)))

(defun mark-order (ents)
(setq i 0)
(foreach
   ent ents
   (cond
   ((/="INSERT" (entity:getdxf ent 0))
      ;; 取文字中点
      (setq pt-mid (apply 'point:mid (entity:getbox ent 0)))
      ;; 高度，角度
      (setq h (entity:getdxf ent 40))
      (setq ang (entity:getdxf ent 50))
      (entity:putdxf
       (entity:make-text
(strcat (itoa (setq i (1+ i)))"#")
(polar pt-mid (+ (* 0.5 pi) ang) h)
(* 0.9 h)
ang 0.8 0 "MM")
       62
       1
       ))
   ;; 块引用
   ((="INSERT" (entity:getdxf ent 0))
      (setq pt-ins (entity:getdxf ent 10))
      (setq ang-ins (entity:getdxf ent 50))
      (setq scale-ins (entity:getdxf ent 41))
      (setq subents (block:ent-list(setq blkname (entity:getdxf ent 2))))
      (setq pt-base (entity:getdxf (tblobjname "block" blkname) 10))
      (setq subents
      (vl-remove-if-not
       '(lambda(x)
         (and (wcmatch (entity:getdxf x 0) "*TEXT")
    (check-text x)))
       subents)
      )
      (foreach
       subent subents
       ;; 取文字中点 坐标变换
       ;;(print (entity:getbox subent 0))
       (setq pt-mid(apply 'point:mid (entity:getbox subent 0)))
       (setq pt-mid (block:bcs2wcs pt-mid pt-base pt-ins ang-ins scale-ins))
       ;; 高度，角度
       (setq h (entity:getdxf subent 40))
       (setq ang (+ (entity:getdxf subent 50)
      ang-ins
      ))
       (entity:putdxf
(entity:make-text
   (strcat (itoa (setq i (1+ i)))"#")
   (polar pt-mid (+ (* 0.5 pi) ang) h)
   (* 0.9 h)
   ang 0.8 0 "MM")
62
1
)))
   
      )))

liuhe 发表于 2023-8-4 13:44:38

快内文字;P，这么麻烦的替换，是不是绘图不规范啊。

jh3030912 发表于 2023-8-4 14:42:09

liuhe 发表于 2023-8-4 13:44
快内文字，这么麻烦的替换，是不是绘图不规范啊。

是的，图纸很不规范，乱七八糟的，扒图和统计起来经常有漏的和错误的

vitalgg 发表于 2023-8-4 15:27:49

有没有这种情况
M33MM55
如果有，算哪种？

jh3030912 发表于 2023-8-4 15:30:10

vitalgg 发表于 2023-8-4 15:27
有没有这种情况
M33MM55
如果有，算哪种？

基本上 不会存在这种情况的，都是单独的 ，要不M33，要不MM55

jh3030912 发表于 2023-8-4 19:36:37

vitalgg 发表于 2023-8-4 18:59


老师，大概就是这种效果的，我是小白刚接触，不知道怎么使用这个代码，是复制下来做成LSP格式还是？启动命令是什么？我按照视频的命令 ERASE 是删除命令

jh3030912 发表于 2024-4-4 23:36:41

vitalgg 发表于 2023-8-4 12:05


老哥你好。这个能不能再帮忙更新一下，1、编号 和 查找的文字 用一个斜线连接或者 圈起来2、编号和查找的文字 整体可以提取到EXCEL表格，例如提取出来为   1# FM甲1021    2#M2535    3#C5800
页: [1]
查看完整版本: 寻求 批量查找特定文字 在其 文字上方加入 带序号前缀