不开图-文件夹批量替换字，看能不能再优化！
本帖最后由 spp_wall 于 2015-8-7 16:43 编辑通过论坛的整合了个批量替换字的，看代码有没问题
现在是要自己改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)
这个好像不错！！！怎么改？ ;;; 《图纸目录》v1.2
;;; ======================================================================
;;; 说明：本程序批量将同一目录下多张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)
(if (> (setq dcl_id (load_dialog "pgdhz.dcl")) 0) (progn ; 加载对话框plml.dcl
(if (new_dialog "pgdhz" dcl_id) (progn
(setq path (getvar "DWGPREFIX")) ; 读取当前图纸路径
(set_tile "e01" path) ; 在对话框中显示路径
(setq file_list (vl-directory-files path "*.dwg")) ; 得到文件夹内所有图纸的列表
(show_list "e02" file_list) ; 对话框中显示所有图纸的列表
(action_tile "accept" "(readata)(done_dialog 1)") ; 按钮执行生成.scr脚本子程序
(action_tile "cancel" "(done_dialog 0)")
(setq bb (start_dialog)) ; 显示对话框plml.dcl
)
(princ "\n无法显示对话框！")
)
(unload_dialog dcl_id)
)
(princ "\n无法加载对话框！")
)
(if (= bb 1) (tzml01)) ; 这个就是生成.scr脚本子程序
(princ)
)
(defun readata ()
(setq oldch (get_tile "e03"))
(setq newch (get_tile "e04"))
)
;;; 显示对话框内列表内容
(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
subln (strlen oldch))
(repeat (setq i (sslength sstxt))
(setq edata (entget (ssname sstxt (setq i (1- i))))
etext (cdr (assoc 1 edata)))
(if (wcmatch etext (strcat "*" oldch "*")) (progn
(setq newtext (vl-string-translate oldch newch etext))
(entmod (subst (cons 1 newtext) (assoc 1 edata) edata))
(setq ct0 (1+ ct0))
))
)
))
(princ)
)
(princ)pgdhz:dialog{
label="original：langjsREVISE：KX";
:column{
spacer_1;
:text{label=" 《KX-批量改单行+属性文字（自己改代码）》 ";}
spacer_1;
:row{
spacer_1;
:edit_box{label="路径: ";key="e01";edit_width=50;}
}
spacer_1;
:list_box{key="e02";width=52;height=10;}
:boxed_row{
label="替换内容";
:edit_box{label="原内容";key="e03";edit_width=20;}
:edit_box{label="替换为";key="e04";edit_width=20;}
}
spacer_1;
:row{
spacer_1;
spacer_1;
spacer_1;
spacer_1;
spacer_1;
spacer_1;
:button{label="确定";key="accept";is_default=true;}
cancel_button;
spacer_1;
spacer_1;
spacer_1;
spacer_1;
spacer_1;
spacer_1;
}
}
}
ZZXXQQ 发表于 2015-8-8 19:39 static/image/common/back.gif
谢谢 ==看看 ZZXXQQ 发表于 2015-8-8 19:39 static/image/common/back.gif
对话框出来的，但是好像程序没有执行 没有替换文字
有空 帮忙看看 谢谢 本帖最后由 h2295 于 2024-7-15 23:14 编辑
修改的代码，可以正常替换文字，但是还是不能实现不打开图纸替换，而是自动打开每张图进行替换后保存关闭，望大佬继续更新
;;; 《图纸目录》v1.3
;;; ======================================================================
;;; 说明：本程序批量将同一目录下多张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)
(if (> (setq dcl_id (load_dialog "D:\\work\\zbzh\\pgdhz.dcl")) 0) (progn ; 加载对话框plml.dcl
(if (new_dialog "pgdhz" dcl_id) (progn
(setq path (getvar "DWGPREFIX")) ; 读取当前图纸路径
(set_tile "e01" path) ; 在对话框中显示路径
(setq file_list (vl-directory-files path "*.dwg")) ; 得到文件夹内所有图纸的列表
(show_list "e02" file_list) ; 对话框中显示所有图纸的列表
(action_tile "accept" "(readata) (done_dialog 1)"); 按钮执行生成.scr脚本子程序
(action_tile "cancel" "(done_dialog 0)")
(princ oldch)
(princ newch)
(setq bb (start_dialog)) ; 显示对话框plml.dcl
)
(princ "\n无法显示对话框！")
)
(unload_dialog dcl_id)
)
(princ "\n无法加载对话框！")
)
(if (= bb 1) (tzml01)) ; 这个就是生成.scr脚本子程序
(princ)
)
(defun readata ()
(setq oldch (get_tile "e03"))
(setq newch (get_tile "e04"))
)
;;; 显示对话框内列表内容
(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:\\WINDOWS\\temp\\批量改单行字.TXT" "w")) ; 生成一个临时txt用于存储图纸里边的信息
(write-line oldch file)
(write-line newch file)
(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程序?
(setq lin (strcat "open " "\"" (strcat path (nth m file_list)) "\"" " kx-pl-gdhz" " qsave" " close"))
; 该图纸信息后关闭
(write-line lin file)
(setq m (+ m 1))
)
; (setq lin (strcat "open \"" (strcat path (nth m file_list)) "\" kx-pl-gdhz qsave close"))
(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 file (open "c:\\WINDOWS\\temp\\批量改单行字.TXT" "r"))
(if file
(progn
(setq oldch (read-line file) ; 要查找的文本内容，自己修改
newch (read-line file) ; 要替换的文本内容，自己修改
)))
(if (and (/= "" oldch)
(/= oldch newch)
(setq sstxt (ssget "x" '((0 . "*TEXT"))))) (progn
; (princ oldch)
; (princ newch)
(setq ssl (sslength sstxt)
ct0 0
subln (strlen oldch))
(repeat (setq i (sslength sstxt))
(setq edata (entget (ssname sstxt (setq i (1- i))))
etext (cdr (assoc 1 edata)))
(if (wcmatch etext (strcat "*" oldch "*")) (progn
(princ oldch)
(princ newch)
(princ etext)
(setq newtext (vl-string-subst newch oldch etext))
; (setq newtext (vl-string-translate oldch newch etext))
(princ newtext)
(entmod (subst (cons 1 newtext) (assoc 1 edata) edata))
(setq ct0 (1+ ct0))
))
)
))
(princ)
)
(princ)
h2295 发表于 2024-7-15 23:13
修改的代码，可以正常替换文字，但是还是不能实现不打开图纸替换，而是自动打开每张图进行替换后保存关闭， ...
感谢大侠分享，可惜不明白我实现不了 厉害！感谢高手！ 'iMini迷你工具'有这个完美实施的功能！QQ群Mini迷你工具三482025963 感谢大侠分享，
页:
[1]