本帖最后由 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



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

  47.   (close fn)
  48.   (setq fn (open fname "r"))
  49.   (setq dclid (load_dialog fname))
  50.   (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"))))
  51.   (new_dialog (substr lin 1 (vl-string-search " " lin)) dclid)
  52.     (if oldch
  53.       (set_tile "oldword" oldch)
  54.       (set_tile "oldword" "")
  55.     )
  56.     (if newch
  57.       (set_tile "newword" newch)
  58.       (set_tile "newword" "")
  59.     )
  60.           (mode_tile "oldword" 2)
  61.           (action_tile "oldword" "(setq oldch $value)")
  62.           (action_tile "newword" "(setq newch $value)")
  63.           (action_tile "1" "(done_dialog 1)")
  64.           (action_tile "2" "(done_dialog 2)")
  65.           (action_tile "3" "(done_dialog 3)")
  66.           (action_tile "cancel" "(done_dialog 0)")
  67.      
  68.   (setq re (start_dialog))
  69.      (cond
  70.       ((= re 1) (shiqu1))
  71.       ((= re 2) (shiqu2))
  72.       ((= re 3) (tihuan))
  73.   )
  74.   
  75.   (start_dialog)
  76.   (unload_dialog dclid)
  77.   (close fn)
  78.   (vl-file-delete fname)
  79. );end xsdhk

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

  162. (xsdhk)
  163. (command "_.undo" "_end")
  164. (setvar "cmdecho" 1)
  165. (princ)
  166. )



该贴已经同步到 CTC的微博


网友答: 本帖最后由 CTC 于 2012-4-20 21:42 编辑
print1985 发表于 2012-4-20 17:36
试试 小改了下 其它代码没动
其实这个查查替换是有问题的（针对某些单个汉字可能会出问题）

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







网友答: 本帖最后由 迷失1786 于 2023-6-15 12:11 编辑

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


网友答: 这个相当于有用，感谢楼主分享

网友答: 支持  顶一下 希望高手出手相助

网友答: http://bbs.mjtd.com/forum.php?mo ... mp;page=1#pid501237
这里有个更好的

网友答: 拾取功能很简单 自己把2个lsp组装下就行了

网友答:

网友答: 试试 小改了下 其它代码没动
其实这个查查替换是有问题的（针对某些单个汉字可能会出问题）

网友答: 楼主的代码对有换行的多行文字也有问题 2个查找替换都有问题啊

网友答: 貌似有点高深。。

网友答: 做个记号，以后学习。
  • 上一篇：分享一个小功能，石材 自动排版
  • 下一篇：没有了
    CAD技术交流中心 | 建筑CAD | 给排水CAD | 暖通CAD | 电气CAD | 电力CAD | 机械CAD | CAD母线槽 | CAD看图
    Copyright © 2019 - 2025