20231120更-完整源码-字串搜索定位及选择替换--支持*TEXT,*LEADER,DIM..块属性..

wzg356

20231120“字符串搜索定位替换3.0.lsp/fas”选择搜索对象时---回车=全图搜索
=========================
20230924更，修正取得文字包围盒的小bug
字符串搜索定位替换-非分解定位版.lsp"速度问题基本解决，但只适用左对正，放弃了，继续搞代码太长，有兴趣的可以下。
=============================================================
20230908更-实际没有加速，改为查看过程中再取定位坐标--丝滑体验，感觉不到慢,该贴到此结束

推荐方案：“字符串搜索定位替换3.0.lsp/fas”为老版本改进更新--速度优势明显，mtext用分解定位方案，加持“通用参数输入dcl.lsp”（fas已打包-我大部分工具直接用，说明见其它贴）则可拾取文字--主要是不想再写对话框了---下载过的重新下就行了

比选方案："字符串搜索定位替换-非分解定位版.lsp"可用完整，与推荐方案技术路线不同，mtext多行文字采用非分解定位技术，速度稍慢一些（感觉也不明显），由于该方案我已放弃，*LEADER,DIM没有转mtexi(还是炸取metxt)--对分解有偏见者或有其他用途的可以拿去---里面的函数修改一下可取得mtext各行包围框识别自然换行


以上2方案功能结果一样
非分解定位还有其它手段，速度比前述2方案没优势，就不发了
==================================
20230906消缺，MTEXT换行(非自然换行)不匹配
====================
20230904改进，过滤无效的正则匹配，执行效率有所提高
另外，提一个知识点：(ssget'((0 . "MTEXT")(1 . "....")))仅对最后250个字符匹配检索，组码3不参与匹配，故string过滤匹配均放在取得选择集之后
======================================
20230902更，修正bug，增加：属性块/尺寸标注
支持以下五种图元，排除锁定/冻结/关闭层- 可检索到,隐患大
TEXT
INSERT-----只针对属性块的"ATTRIB"值查看/替换
以上两项均属单行文本，执行效率最高

MTEXT
MULTILEADER
DIMENSION---只针对有文字替代的尺寸标注且仅对文字替代查看/替换
以上3项属多行文本,需炸开取得定位坐标,效率慢一些(图元名及属性没改变，也无垃圾产生)
为避免漏选，多行文本过滤放在程序内部引入正则过滤检索--格式变化/换行不影响检索结果

操作选项采用grread跟踪，直接按相应键即可，查看下一项默认回车/空格
每一次替换操作均弹出输入框，以便临时更改替换字符，替换字符无变化直接回车即可。

可以先选择后执行——以便结合选择工具使用提高操作效率
选择工具可参见http://bbs.mjtd.com/thread-183273-1-1.html

本帖的意义在于提供了多行文本查找定位替换的一些思路——含格式变化换行的处理
进一步扩展,有能力的自己加,比如修改替换/未替换处的标记或其他操作

另，有回复提议操作块内文本，因替换涉及块重定义（与所见即所得相违）或改名----而使用者可能不知道该结果，未采纳（会对其它插件误伤）
同样道理，也不对正常显示测量尺寸的标注进行操作

fas与lsp同步更新了，功能一样的
lsp文件比原贴，加收1个币
程序命令c:findr

masterlong

2. ;;去除单行文字中的上下划线标志   ---多行文字中的上下标格式，与单行文字的格式不一样。炸开mt后dt会自动进行转换，导致字符串总长度有差异。
   
3. (defun dtfix( str )
   
4.   (setq str (vl-string-subst "" "%%U" (vl-string-subst "" "%%O" str)))
   
5. )
   
6. ;;多行炸开变单行时，一些特殊的字符自动被转换，需要转换回去。
   
7. (defun spdtfix( str )
   
8.   (setq str (vl-string-subst "%%p" "±" str))        ;\U+00B1
   
9.   (setq str (vl-string-subst "%%c" "\U+2205" str))
   
10.   (setq str (vl-string-subst "%%d" "°" str))        ;\U+00B0
    
11. )
    
12. ;;多行文字提取单行文字   --来自明经  --yuuboo改造，返回列表（list str str2biao）  :::  str为脱格式后完整字符串，str2biao为考虑换行的字符串列表
    
13. (defun mt2dt( MTextString / regex s s1 s2 )
    
14.   (setq regex(vlax-create-object "Vbscript.RegExp")) ;引用正则表达式控件
    
15.   (vlax-put-property regex "IgnoreCase" 0) ;不忽略大小写
    
16.   (vlax-put-property regex "Global" 1) ;匹配方式，全文字匹配
    
17.   (setq s MTextString)
    
18.   
    
19.   ;替换\\字符
    
20.   (vlax-put-property regex "Pattern" "\\\\\\\")
    
21.   (setq s (vlax-invoke-method  regex "Replace" s (chr 1)))
    
22.   ;替换\{字符
    
23.   (vlax-put-property regex "Pattern" "\\\\{")
    
24.   (setq s (vlax-invoke-method  regex "Replace" s (chr 2)))
    
25.   ;替换\}字符
    
26.   (vlax-put-property regex "Pattern" "\\\\}")
    
27.   (setq s (vlax-invoke-method  regex "Replace" s (chr 3)))
    
28.   ;删除段落缩进格式
    
29.   (vlax-put-property regex "Pattern" "\\\\pi(.[^;]*);")
    
30.   (setq s (vlax-invoke-method  regex "Replace" s ""))
    
31.   ;删除制表符格式
    
32.   (vlax-put-property regex "Pattern" "\\\\pt(.[^;]*);")
    
33.   (setq s (vlax-invoke-method  regex "Replace" s ""))
    
34.   ;删除堆迭格式
    
35.   (vlax-put-property regex "Pattern" "\\\\S(.[^;]*)(\\^|#|\\\\)(.[^;]*);")
    
36.   (setq s (vlax-invoke-method  regex "Replace" s ""))
    
37.   ;删除字体、颜色、字高、字距、倾斜、字宽、对齐格式
    
38.   (vlax-put-property regex "Pattern" "(\\\\F|\\\\f|\\\\C|\\\\H|\\\\\T|\\\\Q|\\\\W|\\\\A)(.[^;]*);")
    
39.   (setq s (vlax-invoke-method  regex "Replace" s ""))
    
40.   ;删除下划线、删除线格式
    
41.   (vlax-put-property regex "Pattern" "(\\\\L|\\\\O|\\\\l|\\\\o)")
    
42.   (setq s (vlax-invoke-method  regex "Replace" s ""))
    
43.   ;删除不间断空格格式
    
44.   (vlax-put-property regex "Pattern" "\\\\~")
    
45.   (setq s (vlax-invoke-method  regex "Replace" s ""))
    
46.   ;删除{}
    
47.   (vlax-put-property regex "Pattern" "({|})")
    
48.   (setq s (vlax-invoke-method  regex "Replace" s ""))
    
49.   ;替换回\\,\{,\}字符
    
50.   (vlax-put-property regex "Pattern" "\\x01")
    
51.   (setq s (vlax-invoke-method  regex "Replace" s "\"))
    
52.   (vlax-put-property regex "Pattern" "\\x02")
    
53.   (setq s (vlax-invoke-method  regex "Replace" s "{"))
    
54.   (vlax-put-property regex "Pattern" "\\x03")
    
55.   (setq s (vlax-invoke-method  regex "Replace" s "}"))
    
56.   
    
57.       ;;几个特殊符号更换大小写
    
58.       (setq s (vl-string-subst "%%p" "%%P" (vl-string-subst "%%d" "%%D" (vl-string-subst "%%c" "%%C" s))))
    
59.   
    
60.   ;;;换行处理1
    
61.   (setq s1 s)
    
62.   ;删除回车换行符格式
    
63.   (vlax-put-property regex "Pattern" "\\\\P")
    
64.   (setq s1 (vlax-invoke-method  regex "Replace" s1 ""))
    
65.   ;删除换行符格式（针对Shift+Enter格式）
    
66.   (vlax-put-property regex "Pattern" "\n")
    
67.   (setq s1 (vlax-invoke-method  regex "Replace" s1 ""))
    
68.   
    
69.   ;;;换行处理2
    
70.   (setq s2 s)
    
71.   ;回车换行符格式替换为 "\n"
    
72.   (vlax-put-property regex "Pattern" "\\\\P")
    
73.   (setq s2 (vlax-invoke-method  regex "Replace" s2 "\\n"))
    
74.   ;回车换行符格式替换为 "\n"（针对Shift+Enter格式）
    
75.   (vlax-put-property regex "Pattern" "\n")
    
76.   (setq s2 (vlax-invoke-method  regex "Replace" s2 "\\n"))
    
77.   
    
78. 
    
79.   (vlax-release-object regex)
    
80.   (list s1 (dos_strtokens s2 "\\n" T))
    
81. )

;;去除单行文字中的上下划线标志   ---多行文字中的上下标格式，与单行文字的格式不一样。炸开mt后dt会自动进行转换，导致字符串总长度有差异。<br /> (defun dtfix( str )<br />   (setq str (vl-string-subst "" "%%U" (vl-string-subst "" "%%O" str)))<br /> )<br /> ;;多行炸开变单行时，一些特殊的字符自动被转换，需要转换回去。<br /> (defun spdtfix( str )<br />   (setq str (vl-string-subst "%%p" "±" str))        ;\U+00B1<br />   (setq str (vl-string-subst "%%c" "\U+2205" str))<br />   (setq str (vl-string-subst "%%d" "°" str))        ;\U+00B0<br /> )<br /> ;;多行文字提取单行文字   --来自明经  --yuuboo改造，返回列表（list str str2biao）  :::  str为脱格式后完整字符串，str2biao为考虑换行的字符串列表<br /> (defun mt2dt( MTextString / regex s s1 s2 )<br />   (setq regex(vlax-create-object "Vbscript.RegExp")) ;引用正则表达式控件<br />   (vlax-put-property regex "IgnoreCase" 0) ;不忽略大小写<br />   (vlax-put-property regex "Global" 1) ;匹配方式，全文字匹配<br />   (setq s MTextString)<br />   <br />   ;替换\\字符<br />   (vlax-put-property regex "Pattern" "\\\\\\\")<br />   (setq s (vlax-invoke-method  regex "Replace" s (chr 1)))<br />   ;替换\{字符<br />   (vlax-put-property regex "Pattern" "\\\\{")<br />   (setq s (vlax-invoke-method  regex "Replace" s (chr 2)))<br />   ;替换\}字符<br />   (vlax-put-property regex "Pattern" "\\\\}")<br />   (setq s (vlax-invoke-method  regex "Replace" s (chr 3)))<br />   ;删除段落缩进格式<br />   (vlax-put-property regex "Pattern" "\\\\pi(.[^;]*);")<br />   (setq s (vlax-invoke-method  regex "Replace" s ""))<br />   ;删除制表符格式<br />   (vlax-put-property regex "Pattern" "\\\\pt(.[^;]*);")<br />   (setq s (vlax-invoke-method  regex "Replace" s ""))<br />   ;删除堆迭格式<br />   (vlax-put-property regex "Pattern" "\\\\S(.[^;]*)(\\^|#|\\\\)(.[^;]*);")<br />   (setq s (vlax-invoke-method  regex "Replace" s ""))<br />   ;删除字体、颜色、字高、字距、倾斜、字宽、对齐格式<br />   (vlax-put-property regex "Pattern" "(\\\\F|\\\\f|\\\\C|\\\\H|\\\\\T|\\\\Q|\\\\W|\\\\A)(.[^;]*);")<br />   (setq s (vlax-invoke-method  regex "Replace" s ""))<br />   ;删除下划线、删除线格式<br />   (vlax-put-property regex "Pattern" "(\\\\L|\\\\O|\\\\l|\\\\o)")<br />   (setq s (vlax-invoke-method  regex "Replace" s ""))<br />   ;删除不间断空格格式<br />   (vlax-put-property regex "Pattern" "\\\\~")<br />   (setq s (vlax-invoke-method  regex "Replace" s ""))<br />   ;删除{}<br />   (vlax-put-property regex "Pattern" "({|})")<br />   (setq s (vlax-invoke-method  regex "Replace" s ""))<br />   ;替换回\\,\{,\}字符<br />   (vlax-put-property regex "Pattern" "\\x01")<br />   (setq s (vlax-invoke-method  regex "Replace" s "\"))<br />   (vlax-put-property regex "Pattern" "\\x02")<br />   (setq s (vlax-invoke-method  regex "Replace" s "{"))<br />   (vlax-put-property regex "Pattern" "\\x03")<br />   (setq s (vlax-invoke-method  regex "Replace" s "}"))<br />   <br />       ;;几个特殊符号更换大小写<br />       (setq s (vl-string-subst "%%p" "%%P" (vl-string-subst "%%d" "%%D" (vl-string-subst "%%c" "%%C" s))))<br />   <br />   ;;;换行处理1<br />   (setq s1 s)<br />   ;删除回车换行符格式<br />   (vlax-put-property regex "Pattern" "\\\\P")<br />   (setq s1 (vlax-invoke-method  regex "Replace" s1 ""))<br />   ;删除换行符格式（针对Shift+Enter格式）<br />   (vlax-put-property regex "Pattern" "\n")<br />   (setq s1 (vlax-invoke-method  regex "Replace" s1 ""))<br />   <br />   ;;;换行处理2<br />   (setq s2 s)<br />   ;回车换行符格式替换为 "\n"<br />   (vlax-put-property regex "Pattern" "\\\\P")<br />   (setq s2 (vlax-invoke-method  regex "Replace" s2 "\\n"))<br />   ;回车换行符格式替换为 "\n"（针对Shift+Enter格式）<br />   (vlax-put-property regex "Pattern" "\n")<br />   (setq s2 (vlax-invoke-method  regex "Replace" s2 "\\n"))<br />   <br /> <br />   (vlax-release-object regex)<br />   (list s1 (dos_strtokens s2 "\\n" T))<br /> )

gaics

天天问 发表于 2023-8-24 14:51
我使用的时候也有这个问题，运行后自动窗口自动缩小了，标记框都找不到

替换一下这个函数，我把缩放改为字高的10倍
(defun grdrawboxs (boxs ys / n cmd ps p hi)
  (setq        n   0
        cmd (if        command-s
              command-s
              vl-cmdf
            )
  )
  (while (and (setq ps (nth n boxs))
              (equal "" (getstring "\n输入空格或回车查看:"))
         )
    (setq p (car ps))
    (setq hi (* 10 (distance p (car (reverse ps)))))
    (cmd "_zoom"
         (mapcar '- p (list hi hi))
         (mapcar '+ p (list hi hi))
    )
    (mapcar (function (lambda (a b) (grdraw a b ys)))
            ps
            (cdr ps)
    )
    (grdraw (car ps) (last ps) ys)
    (setq n (1+ n))
  )
  (alert "\n查看结束！")
)

tigcat

感谢楼主分享。

lxl217114

感谢楼主分享

zxh92

666666666666666666666666666

liuhe

find  不好用吗？

wzg356

liuhe 发表于 2023-8-22 13:40
find  不好用吗？

目的不限于查看和替换

p-3-ianlcc

感谢楼主的分享！
这个很方便！！

panliang9

用2007 2010 2020 都测试了一下，但没有挨个看的效果，准备再试一下。

wzg356

panliang9 发表于 2023-8-22 16:06
用2007 2010 2020 都测试了一下，但没有挨个看的效果，准备再试一下。

老师傅啊，查找的字串有没有，看是否有数据返回，box是一堆坐标

panliang9

wzg356 发表于 2023-8-22 16:35
老师傅啊，查找的字串有没有，看是否有数据返回，box是一堆坐标

效果出来了，但不是回车键，是空格键。