明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 9429|回复: 18

●●●●●实用程序:查找替换程序 求再增强●●●●●

  [复制链接]
发表于 2012-4-12 00:17:26 | 显示全部楼层 |阅读模式
本帖最后由 CTC 于 2012-4-20 21:48 编辑



偶得一程序,求修改
说明:CAD自带查找替换,缺拾取文字功能。而这个程序刚好有这个功能,希望各位完美下。

1)增加一按钮“选择范围亮显查找文本数量” 。 如查找文字为“H”,选择范围后,CAD屏上会亮显某个范围内“H”的文字,并在命令行上提示:已找到并选择共 26 个包含“H”的对象,有2个文本重叠。(这个功能是CAD自带的)

2)替换最好支持属性文字。替换时命令行有这样的提示:已找替换了 26 个包含“L”的对象。

朗少的:
http://bbs.mjtd.com/forum.php?mo ... mp;page=1#pid501237



  1. ;支持cad单行和多行文字、TZ单行和多行文字
  2. (defun c:CZ(/ fn x dclid lin return# sstxt ssl ct0 ct edata etext txtln subln schct DCL_ID newtext en1 ob entype a)
  3.   (setvar "cmdecho" 0)
  4.   (command "_.undo" "_begin")
  5. (defun xsdhk();显示对话框
  6.   (setq fname (vl-filename-mktemp nil nil ".dcl"))
  7.   (setq fn (open fname "w"))
  8.       (foreach x '(
  9.                    "  czth : dialog{"
  10.                    "  label=\"查找替换V1.0--阿甘\";"
  11.           "  spacer_1;"
  12.          "  :row {"
  13.                    "  :edit_box"
  14.                    "  {"
  15.                    "    label=\"查找\";"
  16.                    "    key=\"oldword\";"
  17.           "    width = 45 ;"
  18.           "    height = 1.2 ;"
  19.                    "    allow_accept=true;"
  20.                    "  }"
  21.          "  :button{key=\"1\";label=\"拾取\";width=6;}"
  22.          "  }"
  23.           "  spacer;"
  24.          "  :row {"
  25.                    "  :edit_box"
  26.                    "  {"
  27.                    "    label=\"替换\";"
  28.                    "    key=\"newword\";"
  29.           "    width = 45 ;"
  30.           "    height = 1.2 ;"
  31.                    "    allow_accept=true;"
  32.                    "  }"
  33.          "  :button{key=\"2\";label=\"拾取\";width=6;}"  
  34.          "  }"
  35.           "  spacer;"
  36.          "  :row {"
  37.          "  :button{key=\"3\";label=\"选择范围替换\";width=6;}"
  38.                    "  cancel_button;"
  39.                    "}"
  40.          "}"
  41.                   ) ; endlist
  42.         (princ x fn)
  43.         (write-line "" fn)
  44.       ) ; end foreach

  45.   (close fn)
  46.   (setq fn (open fname "r"))
  47.   (setq dclid (load_dialog fname))
  48.   (while (or (eq (substr (setq lin (vl-string-right-trim "\" fn)" (vl-string-left-trim "(write-line \"" (read-line fn)))) 1 2) "//") (eq (substr lin 1 (vl-string-search " " lin)) "") (not (eq (substr lin (+ (vl-string-search " " lin) 1) 9) " : dialog"))))
  49.   (new_dialog (substr lin 1 (vl-string-search " " lin)) dclid)
  50.     (if oldch
  51.       (set_tile "oldword" oldch)
  52.       (set_tile "oldword" "")
  53.     )
  54.     (if newch
  55.       (set_tile "newword" newch)
  56.       (set_tile "newword" "")
  57.     )
  58.           (mode_tile "oldword" 2)
  59.           (action_tile "oldword" "(setq oldch $value)")
  60.           (action_tile "newword" "(setq newch $value)")
  61.           (action_tile "1" "(done_dialog 1)")
  62.           (action_tile "2" "(done_dialog 2)")
  63.           (action_tile "3" "(done_dialog 3)")
  64.           (action_tile "cancel" "(done_dialog 0)")
  65.      
  66.   (setq re (start_dialog))
  67.      (cond
  68.       ((= re 1) (shiqu1))
  69.       ((= re 2) (shiqu2))
  70.       ((= re 3) (tihuan))
  71.   )
  72.   
  73.   (start_dialog)
  74.   (unload_dialog dclid)
  75.   (close fn)
  76.   (vl-file-delete fname)
  77. );end xsdhk

  78. (defun tihuan ()
  79.   (if (and (/= oldch "")(/= oldch newch)
  80. (setq sstxt (ssget '((-4 . "<OR")(0 . "*TEXT")(0 . "TCH_DRAWINGNAME")(-4 . "OR>")))))
  81.     (progn
  82.       (setq ssl (sslength sstxt)
  83.             ct0 0
  84.             ct 0
  85.             subln (strlen oldch)
  86.       oldtxtln (strlen oldch)
  87.       )
  88.       (while (< ct0 ssl)
  89.     (setq en1 (ssname sstxt ct0));图元名
  90.         (setq edata (entget en1);组码
  91.               etext (cdr (assoc 1 edata));文字内容
  92.          entype (cdr (assoc 0 edata));文字类型
  93.               txtln (strlen etext)
  94.               schct 1
  95.               newtext ""
  96.         )
  97.         (while (<= schct txtln)
  98.               (if (= (setq readch (substr etext schct subln)) oldch)
  99.        (setq schct (+ schct subln)
  100.                       a newch)
  101.                 (progn
  102.         (if (> (ascii (substr readch 1 1)) 127);如果是汉字
  103.          (progn
  104.                     (setq readch (substr etext schct (1+ subln)));多读取一个字节
  105.           (setq schct (+ schct 2));加2字节
  106.           (setq a (substr readch 1 2));就取第1.2个字节为a
  107.          )
  108.          (progn
  109.           (setq schct (1+ schct))
  110.           (setq a (substr readch 1 1))
  111.          )
  112.         )
  113.                 )
  114.               )
  115.     (setq newtext (strcat newtext a))
  116.         )
  117.         (if (/= etext newtext)
  118.           (progn     
  119.       (setq ob (vlax-ename->vla-object en1)) ;转换
  120.       (if (= entype "TEXT") (vlax-put-property ob 'TextString newtext)) ;改变特性
  121.       (if (= entype "TCH_MTEXT") (entmod (subst (cons 1 newtext) (assoc 1 edata) edata))) ;改变特性
  122.       (if (= entype "MTEXT") (vlax-put-property ob 'TextString newtext)) ;改变特性
  123.       (if (= entype "TCH_TEXT") (vlax-put-property ob 'Text newtext)) ;改变特性
  124.       (if (= entype "TCH_DRAWINGNAME") (vlax-put-property ob 'NameText newtext)) ;改变特性
  125.             (setq ct (1+ ct))
  126.           )
  127.         )
  128.    (setq ct0 (1+ ct0))
  129.       )
  130.       (alert (strcat "  共替换了" (itoa ct) "个"))
  131.    (princ (strcat ">>>>>>>>>共替换了" (itoa ct) "个"))
  132.     )
  133.   )
  134. );end tihuan
  135. (defun shiqu1 (/ ent1 ent2 entdata enttext)
  136.   (if (setq ent1 (entsel ))
  137.   (progn
  138.     (setq ent2 (car ent1);图元名
  139.             entdata (entget ent2);组码
  140.             enttext (cdr (assoc 1 entdata));文字内容
  141.         )
  142.    (setq oldch enttext)
  143.    (setq newch enttext)
  144.    (xsdhk)
  145. ))
  146. );end shiqu1
  147. (defun shiqu2 (/ ent1 ent2 entdata enttext)
  148.   (if (setq ent1 (entsel ))
  149.   (progn
  150.     (setq ent2 (car ent1);图元名
  151.             entdata (entget ent2);组码
  152.             enttext (cdr (assoc 1 entdata));文字内容
  153.         )
  154.    (setq newch enttext)
  155.    (xsdhk)
  156. ))
  157. );end shiqu2

  158. (xsdhk)
  159. (command "_.undo" "_end")
  160. (setvar "cmdecho" 1)
  161. (princ)
  162. )



该贴已经同步到 CTC的微博

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
 楼主| 发表于 2012-4-20 21:37:51 | 显示全部楼层
本帖最后由 CTC 于 2012-4-20 21:42 编辑
print1985 发表于 2012-4-20 17:36
试试 小改了下 其它代码没动
其实这个查查替换是有问题的(针对某些单个汉字可能会出问题)

高手出招了....
不知什么问题,还请高手指点....
高手,请帮我看下可不可以加入CAD系统里面的查找替换里的
""全部选择"" 按钮,查找的文字会亮显,命令行里会提示""已找到并选择 3 个包含“L1”的对象""
因为我要知道选择了哪些,替换了哪些
这个按键功能用法同原来系统的用法一样就好了...(看下面的图片及动画)





本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
回复 支持 0 反对 1

使用道具 举报

发表于 2023-6-15 12:10:30 | 显示全部楼层
本帖最后由 迷失1786 于 2023-6-15 12:11 编辑

试试源泉插件的TFF功能,我用过最好的查找替换功能,查字显亮,带线,带拾取字,

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x
发表于 2023-4-1 19:50:46 | 显示全部楼层
查找替换文字,非常实用
发表于 2012-4-12 08:41:16 | 显示全部楼层
支持  顶一下 希望高手出手相助
发表于 2012-4-12 09:16:09 | 显示全部楼层

点评

这俩个插件结合起来就好了,确实是langjs 大师的作品没有拾取功能,这个没有亮显功能,小罗头也有一个类似的插件,但是没有源码,  发表于 2012-4-12 12:11
CTC
这个版不错,但不是我要的那种,没有拾取功能。我想的是和CAD查找的那样,有亮显功能,会提示选择(替换)了多少个对象,替换最好支持属性文字。。。。  发表于 2012-4-12 10:56
发表于 2012-4-12 12:49:25 | 显示全部楼层
拾取功能很简单 自己把2个lsp组装下就行了

点评

麻烦仁兄出手一下,发上来,我给你加币  发表于 2012-4-20 15:23
 楼主| 发表于 2012-4-12 17:03:00 | 显示全部楼层
发表于 2012-4-20 17:36:51 | 显示全部楼层
试试 小改了下 其它代码没动
其实这个查查替换是有问题的(针对某些单个汉字可能会出问题)

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有账号?注册

x

点评

给力  发表于 2015-8-23 10:06
很给力的东西,谢谢了,但是您说的问题我还没有发现出来,在06版本和07 版本下正常  发表于 2012-4-21 22:42

评分

参与人数 2明经币 +2 收起 理由
tianyi1230 + 1 给力的程序,可否将QQ号留下,交流一下,顺.
CTC + 1 很给力!

查看全部评分

发表于 2012-4-20 17:39:13 | 显示全部楼层
楼主的代码对有换行的多行文字也有问题 2个查找替换都有问题啊
发表于 2012-4-20 21:16:34 | 显示全部楼层
貌似有点高深。。
发表于 2012-6-14 18:42:06 来自手机 | 显示全部楼层
做个记号,以后学习。
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-11-25 09:58 , Processed in 0.232842 second(s), 37 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表