查找并替换不带

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

试试这个，但是很快又脏

copy


(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

这就是为什么。
替换此：

copy

          (if (eq "D.F." (vla-get-textstring obj))
    (vla-put-textstring obj "DF")
  )

有了这个：

copy

          (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

当然，试试这个：

copy

;;  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

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

copy


(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)

[编程交流] 查找并替换不带

发表回复

精选推荐