不开图-文件夹批量替换字，看能不能再优化！

spp_wall

    通过论坛的整合了个批量替换字的，看代码有没问题
   现在是要自己改lisp里面的文字才能运行，看能不能优化下，在对话框上输入要替换的文字，因为毕竟每次修改代码比较麻烦！

;;; 说明：本程序批量将同一目录下多张dwg图纸目录的自动生成。使用前必须将本程
;;;       序加载到cad的启动组中。pccad用，其它图纸自己修改
;;;
;;; 使用：打开目录下任何一张图纸，命令行输入tzml，回车，弹出对话框，按“确
;;;       定”按钮即可。
;;;
;;; 作者：langjs     qq:59509100　　 　命令:tzml 　 　  日期:2011年3月26日
;;; ======================================================================
;;; 主程序
;;; 编程思路：读取当前打开的图纸目录，得到当前目录下的所有图纸，生成批量处理scr脚本，执行脚本依次打开图纸读取标题栏属性块内的图
;;; 纸名称和图纸代号等信息存于临时txt文本内，最后读取txt内容并画出图纸目录。
(defun c:kx-pgdhz (/ bb dcl_pt file_list index_value path)
  (setvar "cmdecho" 0)
       
  (setq index_value (load_dialog "pgdhz.dcl")) ; 显示对话框plml.dcl
  (new_dialog "pgdhz" index_value "" dcl_pt)
  (setq path (getvar "DWGPREFIX"))     ; 读取当前图纸路径
  (set_tile "e01" path)                       ; 在对话框中显示路径
  (setq file_list (vl-directory-files path "*.dwg")) ; 得到文件夹内所有图纸的列表
  (show_list "e02" file_list)               ; 对话框中显示所有图纸的列表
  (action_tile "e03" " (setq dcl_pt (done_dialog 1))  ") ; 按钮执行生成.scr脚本子程序
  (setq bb (start_dialog))
  (if (= bb 1)
    (tzml01)                               ; 这个就是生成.scr脚本子程序
  )
  (princ)
)
;;; 显示对话框内列表内容
(defun show_list (key newlist)
  (start_list key)
  (mapcar
    'add_list
    newlist
  )
  (end_list)
)
;;; 生成.scr脚本子程序
(defun tzml01 (/ file file_list len lin m path)
  (setvar "cmdecho" 0)                       ; 关闭命令响应
  (setvar "filedia" 0)                       ; filedia 设置为 1，为脚本运行设置环境
  (vl-load-com)
  (setq path (getvar "DWGPREFIX"))     ; 读取当前图纸路径
  (setq file_list (vl-directory-files path "*.dwg")) ; 得到文件夹内所有图纸的列表
  (setq len (length file_list))
  (setq m 0)
  (setq file (open "c:\\批量改单行字.TXT" "w")) ; 生成一个临时txt用于存储图纸里边的信息
  (close file)
  (setq file (open "c:\\WINDOWS\\temp\\SCR.txt" "w")) ; 生成一个txt用来做脚本
  (write-line "qsave close" file)      ; 脚本里的内容:关闭当前图纸
  (repeat (- len 1)
    (setq lin (strcat "open " "\"" (strcat path (nth m file_list)) "\"" " kx-pl-gdhz" " qsave" " close")) ; 脚本里的内容:打开图纸执行KX-ml-kspp程序?
                                       ; 该图纸信息后关闭
    (write-line lin file)
    (setq m (+ m 1))
  )
  (setq lin (strcat "open " "\"" (strcat path (nth m file_list)) "\"" " kx-pl-gdhz" " qsave" " close"))
  (write-line lin file)
  ;(setq lin "new ")                       ; 脚本里的内容:新建一个空白图纸
  ;(write-line lin file)
  ;(write-line "ML_OK" file)               ; 脚本里的内容:执行ml_ok程序绘制图纸目录以及内容
  (close file)
  (vl-file-delete "C:/WINDOWS/temp/SCR.scr") ; 如果该目录下有早期留下的脚本就删除掉防止崇明覆盖不了
  (vl-file-rename "C:/WINDOWS/temp/SCR.txt" "C:/WINDOWS/temp/SCR.scr") ; 将刚才建的txt改为脚本
  (command "script" "C:/WINDOWS/temp/SCR.scr") ; 运行脚本用open依次打开图纸执行ml程序读取该图纸信息后关闭
  (setvar "filedia" 1)
  (setvar "cmdecho" 0)
  (princ)
)
;;; 读取该图纸信息子程序
(vl-load-com)

(defun strsplit        (string delimited / pos lst)
  (while (setq pos (vl-string-search delimited string))
    (setq lst         (cons (substr string 1 pos) lst)
                        string (substr string (+ pos 1 (strlen delimited)))
    )
  )
  (reverse (cons string lst))
)

(defun parse-filename ()
  (strsplit (vl-string-trim " \r\t\n" (vl-filename-base (getvar "DWGNAME"))) " ")
)



;;; 文本批量替换根据cabinsummer程序整理。
(defun c:kx-pl-gdhz (/ ct0 ct1 ct2 edata etext newch newtext oldch readch schct ssl sstxt subln txtln)
  (setvar "cmdecho" 0)
  (setq oldch "改字前"                   ; 要查找的文本内容，自己修改
        newch "改字后"               ; 要替换的文本内容，自己修改

  )
  (if (and
        (/= "" oldch)
        (/= oldch newch)
        (setq sstxt (ssget "x" '((0 . "*TEXT"))))
      )
    (progn
      (setq ssl (sslength sstxt)
            ct0 0
            ct1 0
            ct2 0
            subln (strlen oldch)
      )
      (while (< ct0 ssl)
        (setq edata (entget (ssname sstxt ct0))
              etext (cdr (assoc 1 edata))
              txtln (strlen etext)
              schct 1
              newtext ""
        )
        (while (<= schct txtln)
          (setq newtext (strcat newtext (if (= (setq readch (substr etext schct subln))
                                               oldch
                                            )
                                          (setq ct1 (1+ ct1)
                                                schct (+ schct subln)
                                                newch newch
                                          )
                                          (progn
                                            (setq schct (1+ schct))
                                            (substr readch 1 1)
                                          )
                                        )
                        )
          )
        )
        (if (/= etext newtext)
          (progn
            (entmod (subst
                      (cons 1 newtext)
                      (assoc 1 edata)
                      edata
                    )
            )
            (setq ct2 (1+ ct2))
          )
        )
        (setq ct0 (1+ ct0))
      )
    )
  )
  (princ)
)
  (princ)

xiguanyiren_y

这个好像不错！！！怎么改？

ZZXXQQ

2. ;;; 　　　　　　　　　　　《图纸目录》v1.2
   
3. ;;; ======================================================================
   
4. ;;; 说明：本程序批量将同一目录下多张dwg图纸目录的自动生成。使用前必须将本程
   
5. ;;;       序加载到cad的启动组中。pccad用，其它图纸自己修改
   
6. ;;;
   
7. ;;; 使用：打开目录下任何一张图纸，命令行输入tzml，回车，弹出对话框，按“确
   
8. ;;;       定”按钮即可。
   
9. ;;;
   
10. ;;; 作者：langjs     qq:59509100　　 　命令:tzml 　 　  日期:2011年3月26日
    
11. ;;; ======================================================================
    
12. ;;; 主程序
    
13. ;;; 编程思路：读取当前打开的图纸目录，得到当前目录下的所有图纸，生成批量处理
    
14. ;;;           scr脚本，执行脚本依次打开图纸读取标题栏属性块内的图纸名称和图
    
15. ;;;           纸代号等信息存于临时txt文本内，最后读取txt内容并画出图纸目录。
    
16. (defun c:kx-pgdhz (/ bb dcl_pt file_list index_value path)
    
17. (setvar "CMDECHO" 0)
    
18. (if (> (setq dcl_id (load_dialog "pgdhz.dcl")) 0) (progn ; 加载对话框plml.dcl
    
19.   (if (new_dialog "pgdhz" dcl_id) (progn
    
20.    (setq path (getvar "DWGPREFIX")) ; 读取当前图纸路径
    
21.    (set_tile "e01" path)                         ; 在对话框中显示路径
    
22.    (setq file_list (vl-directory-files path "*.dwg")) ; 得到文件夹内所有图纸的列表
    
23.    (show_list "e02" file_list)            ; 对话框中显示所有图纸的列表
    
24.    (action_tile "accept" "(readata)(done_dialog 1)") ; 按钮执行生成.scr脚本子程序
    
25.    (action_tile "cancel" "(done_dialog 0)")
    
26.    (setq bb (start_dialog))         ; 显示对话框plml.dcl
    
27.   )
    
28.    (princ "\n无法显示对话框！")
    
29.   )
    
30.   (unload_dialog dcl_id)
    
31. )
    
32.   (princ "\n无法加载对话框！")
    
33. )
    
34. (if (= bb 1) (tzml01))                               ; 这个就是生成.scr脚本子程序
    
35. (princ)
    
36. )
    
37. (defun readata ()
    
38. (setq oldch (get_tile "e03"))
    
39. (setq newch (get_tile "e04"))
    
40. )
    
41. ;;; 显示对话框内列表内容
    
42. (defun show_list (key newlist)
    
43.   (start_list key)
    
44.   (mapcar 'add_list newlist)
    
45.   (end_list)
    
46. )
    
47. ;;; 生成.scr脚本子程序
    
48. (defun tzml01 (/ file file_list len lin m path)
    
49.   (setvar "cmdecho" 0)                       ; 关闭命令响应
    
50.   (setvar "filedia" 0)                       ; filedia 设置为 1，为脚本运行设置环境
    
51.   (vl-load-com)
    
52.   (setq path (getvar "DWGPREFIX"))     ; 读取当前图纸路径
    
53.   (setq file_list (vl-directory-files path "*.dwg")) ; 得到文件夹内所有图纸的列表
    
54.   (setq len (length file_list))
    
55.   (setq m 0)
    
56.   (setq file (open "c:\\批量改单行字.TXT" "w")) ; 生成一个临时txt用于存储图纸里边的信息
    
57.   (close file)
    
58.   (setq file (open "c:\\WINDOWS\\temp\\SCR.txt" "w")) ; 生成一个txt用来做脚本
    
59.   (write-line "qsave close" file)      ; 脚本里的内容:关闭当前图纸
    
60.   (repeat (- len 1)
    
61.     (setq lin (strcat "open "" (strcat path (nth m file_list)) "" kx-pl-gdhz qsave close")) ; 脚本里的内容:打开图纸执行KX-ml-kspp程序?
    
62.                                        ; 该图纸信息后关闭
    
63.     (write-line lin file)
    
64.     (setq m (+ m 1))
    
65.   )
    
66.   (setq lin (strcat "open "" (strcat path (nth m file_list)) "" kx-pl-gdhz qsave close"))
    
67.   (write-line lin file)
    
68.   ;(setq lin "new ")                       ; 脚本里的内容:新建一个空白图纸
    
69.   ;(write-line lin file)
    
70.   ;(write-line "ML_OK" file)               ; 脚本里的内容:执行ml_ok程序绘制图纸目录以及内容
    
71.   (close file)
    
72.   (vl-file-delete "C:/WINDOWS/temp/SCR.scr") ; 如果该目录下有早期留下的脚本就删除掉防止崇明覆盖不了
    
73.   (vl-file-rename "C:/WINDOWS/temp/SCR.txt" "C:/WINDOWS/temp/SCR.scr") ; 将刚才建的txt改为脚本
    
74.   (command "script" "C:/WINDOWS/temp/SCR.scr") ; 运行脚本用open依次打开图纸执行ml程序读取该图纸信息后关闭
    
75.   (setvar "filedia" 1)
    
76.   (setvar "cmdecho" 0)
    
77.   (princ)
    
78. )
    
79. ;;; 读取该图纸信息子程序
    
80. (vl-load-com)
    
81. (defun strsplit (string delimited / pos lst)
    
82. (while (setq pos (vl-string-search delimited string))
    
83.    (setq lst (cons (substr string 1 pos) lst)
    
84.                         string (substr string (+ pos 1 (strlen delimited)))
    
85.    )
    
86. )
    
87. (reverse (cons string lst))
    
88. )
    
89. (defun parse-filename ()
    
90.   (strsplit (vl-string-trim " \r\t\n" (vl-filename-base (getvar "DWGNAME"))) " ")
    
91. )
    
92. ;;; 文本批量替换根据cabinsummer程序整理。
    
93. (defun c:kx-pl-gdhz (/ ct0 ct1 ct2 edata etext newch newtext oldch readch schct ssl sstxt subln txtln)
    
94. (setvar "cmdecho" 0)
    
95. ; (setq oldch "改字前" ; 要查找的文本内容，自己修改
    
96. ;       newch "改字后" ; 要替换的文本内容，自己修改
    
97. ; )
    
98. (if (and (/= "" oldch)
    
99.           (/= oldch newch)
    
100.           (setq sstxt (ssget "x" '((0 . "*TEXT"))))) (progn
     
101.   (setq ssl (sslength sstxt)
     
102.         ct0 0
     
103.         subln (strlen oldch))
     
104.   (repeat (setq i (sslength sstxt))
     
105.    (setq edata (entget (ssname sstxt (setq i (1- i))))
     
106.          etext (cdr (assoc 1 edata)))
     
107.    (if (wcmatch etext (strcat "*" oldch "*")) (progn
     
108.     (setq newtext (vl-string-translate oldch newch etext))
     
109.     (entmod (subst (cons 1 newtext) (assoc 1 edata) edata))
     
110.     (setq ct0 (1+ ct0))
     
111.    ))
     
112.   )
     
113. ))
     
114. (princ)
     
115. )
     
116. (princ)

;;; 　　　　　　　　　　　《图纸目录》v1.2<br /> ;;; ======================================================================<br /> ;;; 说明：本程序批量将同一目录下多张dwg图纸目录的自动生成。使用前必须将本程<br /> ;;;       序加载到cad的启动组中。pccad用，其它图纸自己修改<br /> ;;;<br /> ;;; 使用：打开目录下任何一张图纸，命令行输入tzml，回车，弹出对话框，按“确<br /> ;;;       定”按钮即可。<br /> ;;;<br /> ;;; 作者：langjs     qq:59509100　　 　命令:tzml 　 　  日期:2011年3月26日<br /> ;;; ======================================================================<br /> ;;; 主程序<br /> ;;; 编程思路：读取当前打开的图纸目录，得到当前目录下的所有图纸，生成批量处理<br /> ;;;           scr脚本，执行脚本依次打开图纸读取标题栏属性块内的图纸名称和图<br /> ;;;           纸代号等信息存于临时txt文本内，最后读取txt内容并画出图纸目录。<br /> (defun c:kx-pgdhz (/ bb dcl_pt file_list index_value path)<br /> (setvar "CMDECHO" 0)<br /> (if (> (setq dcl_id (load_dialog "pgdhz.dcl")) 0) (progn ; 加载对话框plml.dcl<br />   (if (new_dialog "pgdhz" dcl_id) (progn<br />    (setq path (getvar "DWGPREFIX")) ; 读取当前图纸路径<br />    (set_tile "e01" path)                         ; 在对话框中显示路径<br />    (setq file_list (vl-directory-files path "*.dwg")) ; 得到文件夹内所有图纸的列表<br />    (show_list "e02" file_list)            ; 对话框中显示所有图纸的列表<br />    (action_tile "accept" "(readata)(done_dialog 1)") ; 按钮执行生成.scr脚本子程序<br />    (action_tile "cancel" "(done_dialog 0)")<br />    (setq bb (start_dialog))         ; 显示对话框plml.dcl<br />   )<br />    (princ "\n无法显示对话框！")<br />   )<br />   (unload_dialog dcl_id)<br /> )<br />   (princ "\n无法加载对话框！")<br /> )<br /> (if (= bb 1) (tzml01))                               ; 这个就是生成.scr脚本子程序<br /> (princ)<br /> )<br /> (defun readata ()<br /> (setq oldch (get_tile "e03"))<br /> (setq newch (get_tile "e04"))<br /> )<br /> ;;; 显示对话框内列表内容<br /> (defun show_list (key newlist)<br />   (start_list key)<br />   (mapcar 'add_list newlist)<br />   (end_list)<br /> )<br /> ;;; 生成.scr脚本子程序<br /> (defun tzml01 (/ file file_list len lin m path)<br />   (setvar "cmdecho" 0)                       ; 关闭命令响应<br />   (setvar "filedia" 0)                       ; filedia 设置为 1，为脚本运行设置环境<br />   (vl-load-com)<br />   (setq path (getvar "DWGPREFIX"))     ; 读取当前图纸路径<br />   (setq file_list (vl-directory-files path "*.dwg")) ; 得到文件夹内所有图纸的列表<br />   (setq len (length file_list))<br />   (setq m 0)<br />   (setq file (open "c:\\批量改单行字.TXT" "w")) ; 生成一个临时txt用于存储图纸里边的信息<br />   (close file)<br />   (setq file (open "c:\\WINDOWS\\temp\\SCR.txt" "w")) ; 生成一个txt用来做脚本<br />   (write-line "qsave close" file)      ; 脚本里的内容:关闭当前图纸<br />   (repeat (- len 1)<br />     (setq lin (strcat "open "" (strcat path (nth m file_list)) "" kx-pl-gdhz qsave close")) ; 脚本里的内容:打开图纸执行KX-ml-kspp程序?<br />                                        ; 该图纸信息后关闭<br />     (write-line lin file)<br />     (setq m (+ m 1))<br />   )<br />   (setq lin (strcat "open "" (strcat path (nth m file_list)) "" kx-pl-gdhz qsave close"))<br />   (write-line lin file)<br />   ;(setq lin "new ")                       ; 脚本里的内容:新建一个空白图纸<br />   ;(write-line lin file)<br />   ;(write-line "ML_OK" file)               ; 脚本里的内容:执行ml_ok程序绘制图纸目录以及内容<br />   (close file)<br />   (vl-file-delete "C:/WINDOWS/temp/SCR.scr") ; 如果该目录下有早期留下的脚本就删除掉防止崇明覆盖不了<br />   (vl-file-rename "C:/WINDOWS/temp/SCR.txt" "C:/WINDOWS/temp/SCR.scr") ; 将刚才建的txt改为脚本<br />   (command "script" "C:/WINDOWS/temp/SCR.scr") ; 运行脚本用open依次打开图纸执行ml程序读取该图纸信息后关闭<br />   (setvar "filedia" 1)<br />   (setvar "cmdecho" 0)<br />   (princ)<br /> )<br /> ;;; 读取该图纸信息子程序<br /> (vl-load-com)<br /> (defun strsplit (string delimited / pos lst)<br /> (while (setq pos (vl-string-search delimited string))<br />    (setq lst (cons (substr string 1 pos) lst)<br />                         string (substr string (+ pos 1 (strlen delimited)))<br />    )<br /> )<br /> (reverse (cons string lst))<br /> )<br /> (defun parse-filename ()<br />   (strsplit (vl-string-trim " \r\t\n" (vl-filename-base (getvar "DWGNAME"))) " ")<br /> )<br /> ;;; 文本批量替换根据cabinsummer程序整理。<br /> (defun c:kx-pl-gdhz (/ ct0 ct1 ct2 edata etext newch newtext oldch readch schct ssl sstxt subln txtln)<br /> (setvar "cmdecho" 0)<br /> ; (setq oldch "改字前" ; 要查找的文本内容，自己修改<br /> ;       newch "改字后" ; 要替换的文本内容，自己修改<br /> ; )<br /> (if (and (/= "" oldch)<br />           (/= oldch newch)<br />           (setq sstxt (ssget "x" '((0 . "*TEXT"))))) (progn<br />   (setq ssl (sslength sstxt)<br />         ct0 0<br />         subln (strlen oldch))<br />   (repeat (setq i (sslength sstxt))<br />    (setq edata (entget (ssname sstxt (setq i (1- i))))<br />          etext (cdr (assoc 1 edata)))<br />    (if (wcmatch etext (strcat "*" oldch "*")) (progn<br />     (setq newtext (vl-string-translate oldch newch etext))<br />     (entmod (subst (cons 1 newtext) (assoc 1 edata) edata))<br />     (setq ct0 (1+ ct0))<br />    ))<br />   )<br /> ))<br /> (princ)<br /> )<br /> (princ)

2. pgdhz:dialog{
   
3. label="original：langjs  REVISE：KX";
   
4. :column{
   
5.   spacer_1;
   
6.   :text{label="     　　　《KX-批量改单行+属性文字（自己改代码）》 ";}
   
7.   spacer_1;
   
8.   :row{
   
9.    spacer_1;
   
10.    :edit_box{label="路径: ";key="e01";edit_width=50;}
    
11.   }
    
12.   spacer_1;
    
13.   :list_box{key="e02";width=52;height=10;}
    
14.   :boxed_row{
    
15.    label="替换内容";
    
16.    :edit_box{label="原内容";key="e03";edit_width=20;}
    
17.    :edit_box{label="替换为";key="e04";edit_width=20;}
    
18.   }
    
19.   spacer_1;
    
20.   :row{
    
21.    spacer_1;
    
22.    spacer_1;
    
23.    spacer_1;
    
24.    spacer_1;
    
25.    spacer_1;
    
26.    spacer_1;
    
27.    :button{label="确定";key="accept";is_default=true;}
    
28.    cancel_button;
    
29.    spacer_1;
    
30.    spacer_1;
    
31.    spacer_1;
    
32.    spacer_1;
    
33.    spacer_1;
    
34.    spacer_1;
    
35.   }
    
36. }
    
37. }
    

pgdhz:dialog{<br /> label="original：langjs  REVISE：KX";<br /> :column{<br />   spacer_1;<br />   :text{label="     　　　《KX-批量改单行+属性文字（自己改代码）》 ";}<br />   spacer_1;<br />   :row{<br />    spacer_1;<br />    :edit_box{label="路径: ";key="e01";edit_width=50;}<br />   }<br />   spacer_1;<br />   :list_box{key="e02";width=52;height=10;}<br />   :boxed_row{<br />    label="替换内容";<br />    :edit_box{label="原内容";key="e03";edit_width=20;}<br />    :edit_box{label="替换为";key="e04";edit_width=20;}<br />   }<br />   spacer_1;<br />   :row{<br />    spacer_1;<br />    spacer_1;<br />    spacer_1;<br />    spacer_1;<br />    spacer_1;<br />    spacer_1;<br />    :button{label="确定";key="accept";is_default=true;}<br />    cancel_button;<br />    spacer_1;<br />    spacer_1;<br />    spacer_1;<br />    spacer_1;<br />    spacer_1;<br />    spacer_1;<br />   }<br /> }<br /> }<br />

spp_wall

ZZXXQQ 发表于 2015-8-8 19:39

谢谢 ==看看

spp_wall

ZZXXQQ 发表于 2015-8-8 19:39

对话框出来的，但是好像程序没有执行 没有替换文字

有空 帮忙看看 谢谢

h2295

修改的代码，可以正常替换文字，但是还是不能实现不打开图纸替换，而是自动打开每张图进行替换后保存关闭，望大佬继续更新

2. ;;; 　　　　　　　　　　　《图纸目录》v1.3
   
3. ;;; ======================================================================
   
4. ;;; 说明：本程序批量将同一目录下多张dwg图纸目录的自动生成。使用前必须将本程
   
5. ;;;       序加载到cad的启动组中。pccad用，其它图纸自己修改
   
6. ;;;
   
7. ;;; 使用：打开目录下任何一张图纸，命令行输入tzml，回车，弹出对话框，按“确
   
8. ;;;       定”按钮即可。
   
9. ;;;
   
10. ;;; 作者：langjs     qq:59509100　　 　命令:tzml 　 　  日期:2011年3月26日
    
11. ;;; ======================================================================
    
12. ;;; 主程序
    
13. ;;; 编程思路：读取当前打开的图纸目录，得到当前目录下的所有图纸，生成批量处理
    
14. ;;;           scr脚本，执行脚本依次打开图纸读取标题栏属性块内的图纸名称和图
    
15. ;;;           纸代号等信息存于临时txt文本内，最后读取txt内容并画出图纸目录。
    
16. (defun c:kx-pgdhz (/ bb dcl_pt file_list index_value path)
    
17. (setvar "CMDECHO" 0)
    
18. (if (> (setq dcl_id (load_dialog "D:\\work\\zbzh\\pgdhz.dcl")) 0) (progn ; 加载对话框plml.dcl
    
19.   (if (new_dialog "pgdhz" dcl_id) (progn
    
20.    (setq path (getvar "DWGPREFIX")) ; 读取当前图纸路径
    
21.    (set_tile "e01" path)                         ; 在对话框中显示路径
    
22.    (setq file_list (vl-directory-files path "*.dwg")) ; 得到文件夹内所有图纸的列表
    
23.    (show_list "e02" file_list)            ; 对话框中显示所有图纸的列表
    
24. 
    
25.    (action_tile "accept" "(readata) (done_dialog 1)"); 按钮执行生成.scr脚本子程序
    
26.    (action_tile "cancel" "(done_dialog 0)")
    
27.     (princ oldch)
    
28.     (princ newch)
    
29.    (setq bb (start_dialog))         ; 显示对话框plml.dcl
    
30.   )
    
31.    (princ "\n无法显示对话框！")
    
32.   )
    
33.   (unload_dialog dcl_id)
    
34. )
    
35.   (princ "\n无法加载对话框！")
    
36. )
    
37. (if (= bb 1) (tzml01))                               ; 这个就是生成.scr脚本子程序
    
38. (princ)
    
39. )
    
40. (defun readata ()
    
41. (setq oldch (get_tile "e03"))
    
42. (setq newch (get_tile "e04"))
    
43. )
    
44. ;;; 显示对话框内列表内容
    
45. (defun show_list (key newlist)
    
46.   (start_list key)
    
47.   (mapcar 'add_list newlist)
    
48.   (end_list)
    
49. )
    
50. ;;; 生成.scr脚本子程序
    
51. (defun tzml01 (/ file file_list len lin m path)
    
52.   (setvar "cmdecho" 0)                       ; 关闭命令响应
    
53.   (setvar "filedia" 0)                       ; filedia 设置为 1，为脚本运行设置环境
    
54.   (vl-load-com)
    
55.   (setq path (getvar "DWGPREFIX"))     ; 读取当前图纸路径
    
56.   (setq file_list (vl-directory-files path "*.dwg")) ; 得到文件夹内所有图纸的列表
    
57.   (setq len (length file_list))
    
58.   (setq m 0)
    
59.   (setq file (open "c:\\WINDOWS\\temp\\批量改单行字.TXT" "w")) ; 生成一个临时txt用于存储图纸里边的信息
    
60.   (write-line oldch file)
    
61.   (write-line newch file)
    
62.   (close file)
    
63.   (setq file (open "c:\\WINDOWS\\temp\\SCR.txt" "w")) ; 生成一个txt用来做脚本
    
64.   (write-line "qsave close" file)      ; 脚本里的内容:关闭当前图纸
    
65.   (repeat (- len 1)
    
66.     ; (setq lin (strcat "open "" (strcat path (nth m file_list)) "" kx-pl-gdhz qsave close")) ; 脚本里的内容:打开图纸执行KX-ml-kspp程序?
    
67.     (setq lin (strcat "open " """ (strcat path (nth m file_list)) """ " kx-pl-gdhz" " qsave" " close"))
    
68.                                        ; 该图纸信息后关闭
    
69.     (write-line lin file)
    
70.     (setq m (+ m 1))
    
71.   )
    
72.   ; (setq lin (strcat "open "" (strcat path (nth m file_list)) "" kx-pl-gdhz qsave close"))
    
73.    (setq lin (strcat "open " """ (strcat path (nth m file_list)) """ " kx-pl-gdhz" " qsave" " close"))
    
74.   (write-line lin file)
    
75.   ;(setq lin "new ")                       ; 脚本里的内容:新建一个空白图纸
    
76.   ;(write-line lin file)
    
77.   ;(write-line "ML_OK" file)               ; 脚本里的内容:执行ml_ok程序绘制图纸目录以及内容
    
78.   (close file)
    
79.   (vl-file-delete "c:\\WINDOWS\\temp\\SCR.scr") ; 如果该目录下有早期留下的脚本就删除掉防止崇明覆盖不了
    
80.   (vl-file-rename "c:\\WINDOWS\\temp\\SCR.txt" "c:\\WINDOWS\\temp\\SCR.scr") ; 将刚才建的txt改为脚本
    
81.   (command "script" "c:\\WINDOWS\\temp\\SCR.scr") ; 运行脚本用open依次打开图纸执行ml程序读取该图纸信息后关闭
    
82.   (setvar "filedia" 1)
    
83.   (setvar "cmdecho" 0)
    
84.   (princ)
    
85. )
    
86. ;;; 读取该图纸信息子程序
    
87. (vl-load-com)
    
88. (defun strsplit (string delimited / pos lst)
    
89. (while (setq pos (vl-string-search delimited string))
    
90.    (setq lst (cons (substr string 1 pos) lst)
    
91.                         string (substr string (+ pos 1 (strlen delimited)))
    
92.    )
    
93. )
    
94. (reverse (cons string lst))
    
95. )
    
96. (defun parse-filename ()
    
97.   (strsplit (vl-string-trim " \r\t\n" (vl-filename-base (getvar "DWGNAME"))) " ")
    
98. )
    
99. ;;; 文本批量替换根据cabinsummer程序整理。
    
100. (defun c:kx-pl-gdhz (/ ct0 ct1 ct2 edata etext newch newtext oldch readch schct ssl sstxt subln txtln)
     
101. (setvar "cmdecho" 0)
     
102. (setq file (open "c:\\WINDOWS\\temp\\批量改单行字.TXT" "r"))
     
103. (if file
     
104.     (progn
     
105. (setq oldch (read-line file) ; 要查找的文本内容，自己修改
     
106.        newch (read-line file) ; 要替换的文本内容，自己修改
     
107.   )))
     
108. 
     
109. (if (and (/= "" oldch)
     
110.           (/= oldch newch)
     
111.           (setq sstxt (ssget "x" '((0 . "*TEXT"))))) (progn
     
112.   ; (princ oldch)
     
113.   ; (princ newch)
     
114.   (setq ssl (sslength sstxt)
     
115.         ct0 0
     
116.         subln (strlen oldch))
     
117.   (repeat (setq i (sslength sstxt))
     
118.    (setq edata (entget (ssname sstxt (setq i (1- i))))
     
119.          etext (cdr (assoc 1 edata)))
     
120.    
     
121.    (if (wcmatch etext (strcat "*" oldch "*")) (progn
     
122.    
     
123.     (princ oldch)
     
124.     (princ newch)
     
125.     (princ etext)
     
126.     (setq newtext (vl-string-subst newch oldch etext))                                                
     
127.     ; (setq newtext (vl-string-translate oldch newch etext))
     
128.     (princ newtext)
     
129.     (entmod (subst (cons 1 newtext) (assoc 1 edata) edata))
     
130.     (setq ct0 (1+ ct0))
     
131.    ))
     
132.   )
     
133. ))
     
134. (princ)
     
135. )
     
136. (princ)

;;; 　　　　　　　　　　　《图纸目录》v1.3<br /> ;;; ======================================================================<br /> ;;; 说明：本程序批量将同一目录下多张dwg图纸目录的自动生成。使用前必须将本程<br /> ;;;       序加载到cad的启动组中。pccad用，其它图纸自己修改<br /> ;;;<br /> ;;; 使用：打开目录下任何一张图纸，命令行输入tzml，回车，弹出对话框，按“确<br /> ;;;       定”按钮即可。<br /> ;;;<br /> ;;; 作者：langjs     qq:59509100　　 　命令:tzml 　 　  日期:2011年3月26日<br /> ;;; ======================================================================<br /> ;;; 主程序<br /> ;;; 编程思路：读取当前打开的图纸目录，得到当前目录下的所有图纸，生成批量处理<br /> ;;;           scr脚本，执行脚本依次打开图纸读取标题栏属性块内的图纸名称和图<br /> ;;;           纸代号等信息存于临时txt文本内，最后读取txt内容并画出图纸目录。<br /> (defun c:kx-pgdhz (/ bb dcl_pt file_list index_value path)<br /> (setvar "CMDECHO" 0)<br /> (if (> (setq dcl_id (load_dialog "D:\\work\\zbzh\\pgdhz.dcl")) 0) (progn ; 加载对话框plml.dcl<br />   (if (new_dialog "pgdhz" dcl_id) (progn<br />    (setq path (getvar "DWGPREFIX")) ; 读取当前图纸路径<br />    (set_tile "e01" path)                         ; 在对话框中显示路径<br />    (setq file_list (vl-directory-files path "*.dwg")) ; 得到文件夹内所有图纸的列表<br />    (show_list "e02" file_list)            ; 对话框中显示所有图纸的列表<br /> <br />    (action_tile "accept" "(readata) (done_dialog 1)"); 按钮执行生成.scr脚本子程序<br />    (action_tile "cancel" "(done_dialog 0)")<br />     (princ oldch)<br />     (princ newch)<br />    (setq bb (start_dialog))         ; 显示对话框plml.dcl<br />   )<br />    (princ "\n无法显示对话框！")<br />   )<br />   (unload_dialog dcl_id)<br /> )<br />   (princ "\n无法加载对话框！")<br /> )<br /> (if (= bb 1) (tzml01))                               ; 这个就是生成.scr脚本子程序<br /> (princ)<br /> )<br /> (defun readata ()<br /> (setq oldch (get_tile "e03"))<br /> (setq newch (get_tile "e04"))<br /> )<br /> ;;; 显示对话框内列表内容<br /> (defun show_list (key newlist)<br />   (start_list key)<br />   (mapcar 'add_list newlist)<br />   (end_list)<br /> )<br /> ;;; 生成.scr脚本子程序<br /> (defun tzml01 (/ file file_list len lin m path)<br />   (setvar "cmdecho" 0)                       ; 关闭命令响应<br />   (setvar "filedia" 0)                       ; filedia 设置为 1，为脚本运行设置环境<br />   (vl-load-com)<br />   (setq path (getvar "DWGPREFIX"))     ; 读取当前图纸路径<br />   (setq file_list (vl-directory-files path "*.dwg")) ; 得到文件夹内所有图纸的列表<br />   (setq len (length file_list))<br />   (setq m 0)<br />   (setq file (open "c:\\WINDOWS\\temp\\批量改单行字.TXT" "w")) ; 生成一个临时txt用于存储图纸里边的信息<br />   (write-line oldch file)<br />   (write-line newch file)<br />   (close file)<br />   (setq file (open "c:\\WINDOWS\\temp\\SCR.txt" "w")) ; 生成一个txt用来做脚本<br />   (write-line "qsave close" file)      ; 脚本里的内容:关闭当前图纸<br />   (repeat (- len 1)<br />     ; (setq lin (strcat "open "" (strcat path (nth m file_list)) "" kx-pl-gdhz qsave close")) ; 脚本里的内容:打开图纸执行KX-ml-kspp程序?<br />     (setq lin (strcat "open " """ (strcat path (nth m file_list)) """ " kx-pl-gdhz" " qsave" " close"))<br />                                        ; 该图纸信息后关闭<br />     (write-line lin file)<br />     (setq m (+ m 1))<br />   )<br />   ; (setq lin (strcat "open "" (strcat path (nth m file_list)) "" kx-pl-gdhz qsave close"))<br />    (setq lin (strcat "open " """ (strcat path (nth m file_list)) """ " kx-pl-gdhz" " qsave" " close"))<br />   (write-line lin file)<br />   ;(setq lin "new ")                       ; 脚本里的内容:新建一个空白图纸<br />   ;(write-line lin file)<br />   ;(write-line "ML_OK" file)               ; 脚本里的内容:执行ml_ok程序绘制图纸目录以及内容<br />   (close file)<br />   (vl-file-delete "c:\\WINDOWS\\temp\\SCR.scr") ; 如果该目录下有早期留下的脚本就删除掉防止崇明覆盖不了<br />   (vl-file-rename "c:\\WINDOWS\\temp\\SCR.txt" "c:\\WINDOWS\\temp\\SCR.scr") ; 将刚才建的txt改为脚本<br />   (command "script" "c:\\WINDOWS\\temp\\SCR.scr") ; 运行脚本用open依次打开图纸执行ml程序读取该图纸信息后关闭<br />   (setvar "filedia" 1)<br />   (setvar "cmdecho" 0)<br />   (princ)<br /> )<br /> ;;; 读取该图纸信息子程序<br /> (vl-load-com)<br /> (defun strsplit (string delimited / pos lst)<br /> (while (setq pos (vl-string-search delimited string))<br />    (setq lst (cons (substr string 1 pos) lst)<br />                         string (substr string (+ pos 1 (strlen delimited)))<br />    )<br /> )<br /> (reverse (cons string lst))<br /> )<br /> (defun parse-filename ()<br />   (strsplit (vl-string-trim " \r\t\n" (vl-filename-base (getvar "DWGNAME"))) " ")<br /> )<br /> ;;; 文本批量替换根据cabinsummer程序整理。<br /> (defun c:kx-pl-gdhz (/ ct0 ct1 ct2 edata etext newch newtext oldch readch schct ssl sstxt subln txtln)<br /> (setvar "cmdecho" 0)<br /> (setq file (open "c:\\WINDOWS\\temp\\批量改单行字.TXT" "r"))<br /> (if file<br />     (progn<br /> (setq oldch (read-line file) ; 要查找的文本内容，自己修改<br />        newch (read-line file) ; 要替换的文本内容，自己修改<br />   )))<br /> <br /> (if (and (/= "" oldch)<br />           (/= oldch newch)<br />           (setq sstxt (ssget "x" '((0 . "*TEXT"))))) (progn<br />   ; (princ oldch)<br />   ; (princ newch)<br />   (setq ssl (sslength sstxt)<br />         ct0 0<br />         subln (strlen oldch))<br />   (repeat (setq i (sslength sstxt))<br />    (setq edata (entget (ssname sstxt (setq i (1- i))))<br />          etext (cdr (assoc 1 edata)))<br />    <br />    (if (wcmatch etext (strcat "*" oldch "*")) (progn<br />     <br />     (princ oldch)<br />     (princ newch)<br />     (princ etext) <br />     (setq newtext (vl-string-subst newch oldch etext))                                                <br />     ; (setq newtext (vl-string-translate oldch newch etext))<br />     (princ newtext)<br />     (entmod (subst (cons 1 newtext) (assoc 1 edata) edata))<br />     (setq ct0 (1+ ct0))<br />    ))<br />   )<br /> ))<br /> (princ)<br /> )<br /> (princ)

寒潮大冬瓜

h2295 发表于 2024-7-15 23:13
修改的代码，可以正常替换文字，但是还是不能实现不打开图纸替换，而是自动打开每张图进行替换后保存关闭， ...

感谢大侠分享，可惜不明白我实现不了

tender138

厉害！感谢高手！

寒潮大冬瓜

'iMini迷你工具'有这个完美实施的功能！QQ群Mini迷你工具三482025963

阿猪蛋

感谢大侠分享，