社区 › Auto Lisp › 查找并替换不带

y49sides 发表于 2022-7-6 08:27:15

查找并替换不带

我正在寻找一种自动查找和替换的方法。我有大量带有特定文字符号“D.F.”的图纸需要更改为“DF”。我想通过在工具栏上创建一个lisp和一个图标来为我的用户实现自动化。
我试着在工具栏图标上的宏中写入它，但我不知道如何通过对话框。
谁能给我指出正确的方向，或者用Lisp程序的Lisp程序就能做到？
提前感谢

CarlB 发表于 2022-7-6 08:32:22

你看过这个论坛中类似的帖子吗，如本页底部所示？这个话题已经提过几次了。

y49sides 发表于 2022-7-6 08:36:07

是的，这就是我决定发布这个问题的原因。我在找更具体的东西。
谢谢

fixo 发表于 2022-7-6 08:39:27

试试这个，但是很快又脏
 

(defun C:RT (/ acapp acsp adoc adocs fn fold full_name_list)
(or (vl-load-com))
(setq        fn             (getfiled "Select *ANY .DWG FILE* in a desired folder : "
                       ""
                       "dwg"
                       4
             )
fold             (vl-filename-directory fn)
full_name_list (vl-directory-files fold "*.dwg" 1)
full_name_list (mapcar (function (lambda (x)
                                   (strcat fold "\\" x)
                               )
                     )
                     full_name_list
             )
)
(setq        acapp (vlax-get-acad-object)
adocs (vla-get-documents acapp)
)
(foreach fl full_name_list
   (setq adoc (vla-open adocs fl :vlax-false))
   (setq acsp (vla-get-modelspace adoc))
   (vlax-for lt (vla-get-layouts adoc)
   (vlax-for        obj (vla-get-block lt)
(if (eq "AcDbText" (vla-get-objectname obj))
(if (eq "D.F." (vla-get-textstring obj))
    (vla-put-textstring obj "DF")
)
)
   )
   )
   (vla-save adoc)
   (vla-close adoc)
)
)
(princ "\n\t***\tStart command with RT\t***")
(princ)

 
~'J'~

y49sides 发表于 2022-7-6 08:43:26

非常感谢你。我把它都设置好了，但它并没有切换文本。“D.F.”与其他文本在一个字符串中。这个lisp是否只能查找一个只有“D.F.”的文本字符串？

CAB 发表于 2022-7-6 08:44:41

这就是为什么。
替换此：
          (if (eq "D.F." (vla-get-textstring obj))
    (vla-put-textstring obj "DF")
)
有了这个：
          (if (wcmatch (vla-get-textstring obj) "*D.F.*")
    (vla-put-textstring obj
             (vl-string-subst "DF" "D.F."(vla-get-textstring obj)))
)

y49sides 发表于 2022-7-6 08:50:27

驾驶室
非常感谢你的帮助。
一次只能为一个图形编写此代码吗。
似乎这个代码要求我选择一个。dwg文件，但它贯穿了所有。特定文件夹中的dwg。
再次感谢。

CAB 发表于 2022-7-6 08:52:02

当然，试试这个：
;;Code by Fatty Mod by CAB
(defun C:RT (/ acapp acsp adoc adocs fn)
(vl-load-com)
(if (setq fn (getfiled "Select .DWG FILE to replace text : " "" "dwg" 4))
   (progn
   (setq acapp (vlax-get-acad-object)
         adocs (vla-get-documents acapp)
   )
   (setq adoc (vla-open adocs fn :vlax-false))
   (setq acsp (vla-get-modelspace adoc))
   (vlax-for lt (vla-get-layouts adoc)
       (vlax-for obj (vla-get-block lt)
         (if (eq "AcDbText" (vla-get-objectname obj))
         (if (wcmatch (vla-get-textstring obj) "*D.F.*")
             (vla-put-textstring obj
               (vl-string-subst "DF" "D.F." (vla-get-textstring obj))
             )
         )
         )
       )
   )
   (vla-save adoc)
   (vla-close adoc)
   )
)
(princ)
)

y49sides 发表于 2022-7-6 08:55:01

驾驶室
谢谢，我明天试试。这段代码看起来不适用于。我当前将使用的dwg。看起来用户仍然需要手动选择一个。图纸。我正在寻找它来改变我所在的图纸中的文字。
如果我听起来像个讨厌鬼，我很抱歉。我真的很感谢以上所有信息。
再次感谢

fixo 发表于 2022-7-6 08:58:57

这是经过编辑的版本，抱歉耽搁了
 

(defun C:RT (/ acapp acsp adoc adocs fn fold full_name_list st)
;; local defun
;; by Michael Puckett
(defun Replace ( oldText newText text / i )
(if (/= oldText newText)
(while (setq i (vl-string-search oldText text))
(setq text
(vl-string-subst
newText
oldText
text
i
)
)
)
)
text
)
(or (vl-load-com))
(setq        fn             (getfiled "Select *ANY .DWG FILE* in a desired folder : "
                       ""
                       "dwg"
                       4
             )
fold             (vl-filename-directory fn)
full_name_list (vl-directory-files fold "*.dwg" 1)
full_name_list (mapcar (function (lambda (x)
                                   (strcat fold "\\" x)
                               )
                     )
                     full_name_list
             )
)
(setq        acapp (vlax-get-acad-object)
adocs (vla-get-documents acapp)
)
(foreach fl full_name_list
   (setq adoc (vla-open adocs fl :vlax-false))
   (setq acsp (vla-get-modelSpace adoc))
   (vlax-for lt (vla-get-layouts adoc)
   (vlax-for        obj (vla-get-block lt)
(if (eq "AcDbText" (vla-get-objectname obj))
(if (wcmatch (setq st (vla-get-textstring obj)) "*D.F.*")
    (vla-put-textstring obj (Replace "DF" "D.F." st))
)
)
   )
   )
   (vla-save adoc)
   (vla-close adoc)
)
)
(princ "\n\t***\tStart command with RT\t***")
(princ)

查看完整版本: 查找并替换不带