CAD清理垃圾源代码

(prompt "\n命令是tt.\n使用前请看帮助.")
;;;启动程序
(defun c:tt(/ catchit)
(setq catchit (VL-CATCH-ALL-APPLY 'dcl_load))
(if (vl-catch-all-error-p catchit)
(progn
(princ "\n程序出错信息是:")
(princ (vl-catch-all-error-message catchit))
)
(princ "\n程序正常结束!")
)
(princ) ;防止函数回显
)
;;;加载对话框，并进行处理
(defun DCL_load (/ dcl_id Dialog_Return key keys key1 Dcl_File FS SH COUNT FLST)
(setq dcl_id (load_dialog (setq Dcl_File (Write_Dcl)))) ;对话框加载
(vl-file-delete Dcl_File) ;加载后删除DCL文件
(setq Dialog_Return 2)
(setq sh (vlax-create-object "Shell.Application")) ;Shell.application对象
(setq fs (vlax-create-object "Scripting.FileSystemObject")) ;FSO对象
(setq fLst nil)
(while (> Dialog_Return 1) ;循环控制对话框是否结束
(new_dialog "DCL" dcl_id) ;建立窗体
;;-->-->-对话框初始化->-->--
(setq keys '("ERR" "AC$" "TMP" "DWL" "LOG" "PLT" "SV$"
"BAK" "USR" "UED" "ZERO" "SF" "TF" "LF"
"PF" "UF" "PATH" "SUB" "accept" "cancel")) ;列表全部控件名称
(foreach key keys ;全部控件的初始化
(if (eval (read (strcat key "_bak")))
(set_tile key (eval (read (strcat key "_bak"))))
) ;控件内容
(action_tile key "(Action_DCL_Keys $key $value)") ;点击动作
)
(setq key1 '("ERR" "AC$" "TMP" "DWL" "LOG"
"PLT" "SV$" "BAK" "ZERO" "USR"))
(action_tile "ALL" "(all_select key1)") ;选择全部过滤类型
(action_tile "CLR" "(all_Clear (cons \"ALL\" key1))") ;清楚选择过滤类型
(action_tile "SEL" "(SelectFolder fs sh))") ;自定义文件夹
(action_tile "SHOW" "(ShowFile fs sh)") ;显示找到的文件
(action_tile "SA" "(SelectAll)") ;全选列表框的文件
(action_tile "DA" "(DeselectAll)") ;清选列表框的文件
(action_tile "help" "(helpMsg)") ;帮助信息
;;--<--<-对话框初始化完成-<--<--
(setq Dialog_Return (start_dialog)) ;开启对话框(用户可见)
)
(and sh (vlax-release-object sh)) ;释放fso对象
(and fs (vlax-release-object fs)) ;释放shell对象
(unload_dialog dcl_id) ;退出时卸载对话框
Dialog_Return
)
;;;全部控件的点击动作
(defun Action_DCL_Keys (key valu

e / lst els i err cnt scr str) ;全部控件的点击动作触发
(cond
( (= key "accept") ;{确认按钮}
(setq lst (Get_DCL_Data))
(setq lst (GetFilter lst))
(if (/= (setq els (get_tile "LST")) "")
(progn
(setq els (read (strcat "(" els ")")))
(setq str "str=InputBox(\"你确认要删除这些文件吗?按ESC取消操作,输入yes或者y将删除文件!\", \"警告框\")")
(setq scr (vlax-create-object "ScriptControl"))
(vlax-put Scr "language" "vbs")
(vlax-invoke scr 'ExecuteStatement str)
(setq str (vla-eval scr "str"))
(and str (setq str (strcase str)))
(vlax-release-object scr)
(if (or (= str "YES") (= str "Y"))
(progn
(setq i 0)
(setq err 0)
(setq cnt 0)
(foreach pFile FLst
(if (= i (car els))
(progn
(if (not (vlax-property-available-p pFile 'subFolders))
(progn
;;(princ (strcat "\n这是文件" (vlax-get file 'name)))
(if (vl-catch-all-error-p (vl-catch-all-apply 'vlax-invoke (list pFile 'delete 1)))
(setq err (1+ err))
(setq cnt (1+ cnt))
)
)
;;(princ (strcat "\n这是文件夹" (vlax-get file 'path)))
)
(setq els (cdr els))
)
)
(setq i (1+ i))
)
(princ (strcat "\n删除成功的文件个数是：" (itoa cnt)))
(princ (strcat "\n删除失败的文件个数是：" (itoa err)))
(princ)
)
(princ "\n你取消了操作!")
)
)
(princ "\n你没选择任何文件!")
)
(done_dialog 1) ;对话框退出返回主函数 传递给Dialog_Return值为1
)
( (= key "cancel") ;{取消按钮}
(princ "\n你取消了操作!")
(done_dialog 0) ;对话框退出返回主函数 传递给Dialog_Return值为0
)
)
)
;;;自定义文件夹
(defun SelectFolder(fs sh / pa p)
(setq pa (vlax-invoke sh 'BrowseForFolder 0 "我的电脑" 16 17));打开文件浏览对话框，并获得文件夹对象
(if pa
(progn
(setq p (vlax-get (vlax-get pa 'self) 'path))
(if (/= (vlax-invoke fs 'FolderExists p) 0)
(progn
(and (> (strlen p) 3) (setq p (strcat p "\\")))
(set_tile "PATH" P)
(set_tile "UF" "1")
)
)
)
)
(if pa (vlax-release-object pa))
(princ)
)
;;;全选
;;;(这个函数有个bug,但是我不知道

怎么处理)
(defun SelectAll (/ str i)
(setq STR "")
(setq i 0)
(repeat (length flst)
(setq str (strcat str (itoa i) " "))
(setq i (1+ i))
)
(set_tile "LST" str)
(set_tile "SA" "0")
(set_tile "DA" "0")
)
;;;清选
(defun DeselectAll ()
(set_tile "LST" "")
(set_tile "SA" "0")
(set_tile "DA" "0")
)
;;;显示有哪些文件
(defun ShowFile (fs sh / FILT FOLD LST SIZE STR)
(setq lst (Get_DCL_Data))
(setq lst (GetFilter lst))
(setq size (car lst))
(setq filt (cadr lst))
(setq fold (caddr lst))
(if (or (car size) filt)
(progn
(and filt (removeDup filt))
(setq fold (removeDup fold))
(setq fLst nil)
(start_list "LST")
(foreach p fold
(if (/= (vlax-invoke fs 'FolderExists p) 0)
(Search fs p size filt)
)
)
(end_list)
(setq fLst (reverse Flst))
(SelectAll)
)
)
)
;;;清除重复元素
(defun RemoveDup (lst / tmp L n)
(setq tmp (mapcar 'strcase lst))
(setq tmp (acad_strlsort tmp))
(while tmp
(setq n (car tmp))
(setq L (cons n L))
(while (and (cadr tmp)
(= (car tmp) (cadr tmp))
)
(setq tmp (cdr tmp))
)
(setq tmp (cdr tmp))
)
(reverse L)
)
;;;判断条件
(defun CheckFile (fs file size filLst / name idx suf res1 res2)
(and (car size) (setq res1 (= (vlax-get file 'size) 0)))
(cond
( (member "*.*" filLst)
(setq res2 T)
)
( (setq name (vlax-get file 'name))
(setq idx (vl-string-position (ascii ".") name 0 T))
(if idx
(setq suf (strcase (substr name (+ 2 idx)))
res2 (member suf filLst)
)
)
)
)
(or res1 res2)
)
;;;搜索符合过滤条件的文件
(defun Search (fs Folder size filLst / rfd files file fds fd IsShow)
(if (/= (vlax-invoke fs 'FolderExists Folder) 0) ;防止一些错误(譬如某些文件夹含有不认识的字符)
(progn
(setq rfd (vlax-invoke fs 'GetFolder Folder)) ;得到文件夹的指针
(setq files (vlax-get rfd 'files)) ;得到这个文件夹的文件集
(vlax-for file files
(if (checkFile fs file size filLst) ;对每个文件检测是否符合条件
(progn
(add_list (vlax-get file 'name)) ;符合则加到对话框的列表
(setq fLst (cons file fLst)) ;把文件加入到总列表
(setq IsShow T)
)
)
)
(if IsShow
(progn
(add_list Folder)
(setq fLst (cons rfd fLst))
)
) ;把目录加入到列表中
(if (= (cdr size) "1") ;如果要查找范围包括子目录
(progn
(setq fds (v

lax-get rfd 'SubFolders)) ;对每个子目录
(vlax-for fd fds
(Search fs (vlax-get Fd 'path) size filLst) ;递归进去
)
)
)
;;(vlax-release-object files)
;;(vlax-release-object rfd)
)
)
)

;;;获得过滤选择
(defun GetFilter (kLst / KEY LST PATH SIZE SUF USS IDX SUB)
(setq lst kLst)
(repeat 8
(setq key (car Lst))
(if (= (cdr key) "1")
(setq suf (cons (car key) suf)) ;文件后缀
)
(setq lst (cdr lst))
)

(setq key (car Lst))
(if (= (cdr key) "1") ;如果是自定义后缀
(progn
(setq uss (cdadr Lst)) ;下面应添加非法字符判断，但我没写
(cond
( (or (= uss "*.*")(= uss ".*")(= uss "*"))
(setq suf (cons "*.*" suf)) ;所有文件
)
( (setq idx (vl-string-position (ascii ".") uss 0 T))
(setq suf (cons (substr uss (+ 2 idx)) suf)) ;自定义后缀(带点)
)
( (/= uss "")
(setq suf (cons uss suf)) ;自定义后缀
)
)
)
)
(setq lst (cddr lst))

(setq key (car Lst))
(if (= (cdr key) "1")
(setq size 0) ;零字节文件
)
(setq lst (cdr lst))

(if (= (cdr (assoc "TF" lst)) "1")
(setq path (cons (getvar "TEMPPREFIX") path)) ;临时图形目录
)
(if (= (cdr (assoc "SF" lst)) "1")
(setq path (cons (getvar "SAVEFILEPATH") path)) ;自动保存目录
)
(if (= (cdr (assoc "LF" lst)) "1")
(setq path (cons (strcat (GetSpecialPath 2) "\\") path)) ;系统临时目录
)
(if (= (cdr (assoc "PF" lst)) "1")
(setq path (cons (getvar "DWGPREFIX") path)) ;工作目录
)
(if (= (cdr (assoc "UF" lst)) "1")
(setq path (cons (cdr (assoc "PATH" lst)) path)) ;指定目录
)
(setq size (cons size (get_tile "SUB"))) ;是否包含子目录
(and suf (setq suf (mapcar 'strcase suf)))
(list size suf path)
)
;;;全选后缀
(defun ALL_Select (keys)
(if (= (get_tile "ALL") "1")
(progn
(foreach n keys
(set_tile n "1")
)
(set_tile "CLR" "0")
)
)
)
;;;清除选择
(defun ALL_Clear (keys)
(if (= (get_tile "CLR") "1")
(foreach n (cons "CLR" keys)
(set_tile n "0")
)
)
)
;;;帮助显示
(defun helpMsg ()
(alert "免责申明:\n
\n程序开源，使用本程序后果自负。
\n若要转载，请说明原创和来源网站，尊重作者劳动成果。
\n程序中可以使用快捷键，显示S 打开O 全选A 清选D 包含子目录I;
\n在自定义后缀，无

需输入.，如*.dwg，输入dwg，所有文件，输入*
\n因为程序由vlisp，故不宜选择有大量文件或文件夹的目录;
\n处理数度较慢，请耐心等待。
\n再次提醒：数据无价，虽说是垃圾文件，也请你确认要删除的文件。
\n欢迎使用和建议。\n
\nHighflybird 2010.1.1
")
)
;;;每个控件都赋给一个变量 用于下次开启初始化
(defun Get_DCL_Data (/ key lst value)
(foreach key keys
(setq value (get_tile key))
(setq lst (cons (cons key value) lst))
(set (read (strcat key "_bak")) value)
)
(reverse (cddr lst))
)
;;;获得系统工作路径
(defun GetSpecialPath (n / fso path)
(setq fso (vlax-create-object "Scripting.FileSystemObject"))
(setq path (vlax-get (vlax-invoke fso 'GetSpecialFolder n) 'path))
(vlax-release-object fso)
path
)
;;;临时生成Dcl文件 返回文件名
(defun Write_Dcl (/ Dcl_File file str)
(setq Dcl_File (vl-filename-mktemp nil nil ".Dcl"))
(setq file (open Dcl_File "w"))
(foreach str (list
"//对话框"
"DCL:dialog"
"{"
"label = \"CAD垃圾文件删除工具\";"
":row"
"{"
":column"
"{"
":boxed_column"
"{"
"label = \"文件后缀\"; "
":toggle"
"{"
"key = \"ERR\" ;"
"label = \"(.err)报错文件\" ;"
"}"
":toggle"
"{"
"key = \"AC$\" ;"
"label = \"(.ac$)临时文件\" ;"
"}"
":toggle"
"{"
"key = \"TMP\" ;"
"label = \"(.tmp)临时文件\" ;"
"}"
":toggle"
"{"
"key = \"DWL\" ;"
"label = \"(.dwl,dwl2)临时文件\" ;"
"}"
":toggle"
"{"
"key = \"LOG\" ;"
"label = \"(.log)日志文件\" ;"
"}"
":toggle"
"{"
"key = \"PLT\" ;"
"label = \"(.plt)打印文件\" ;"
"}"
":toggle"
"{"
"key = \"SV$\" ;"
"label = \"(.sv$)自动存盘文件\" ;"
"}"
":toggle"
"{"
"key = \"BAK\" ;"
"label = \"(.bak)备份文件\" ;"
"}"
":tog

gle"
"{"
"key = \"ZERO\" ;"
"label = \"0字节文件\" ;"
"}"
":row"
"{"
":toggle"
"{"
"key = \"USR\" ;"
"label = \"自定义后缀\" ;"
"}"
":edit_box"
"{"
"key = \"UED\";"
"fixed_width = true;"
"width = 16;"
"}"
"}"
":toggle"
"{"
"key = \"ALL\" ;"
"label = \"所有文件\" ;"
"}"
":toggle"
"{"
"key = \"CLR\" ;"
"label = \"清除以上\" ;"
"}"
"}"
":boxed_column"
"{"
"label = \"文件位置\"; "
":toggle"
"{"
"key = \"SF\" ;"
"label = \"自动保存文件夹\" ;"
"}"
":toggle"
"{"
"key = \"TF\" ;"
"label = \"临时图形文件夹\" ;"
"}"
":toggle"
"{"
"key = \"LF\" ;"
"label = \"系统临时文件夹\" ;"
"}"
":toggle"
"{"
"key = \"PF\" ;"
"label = \"当前工作文件夹\" ;"
"}"
":row"
"{"
":toggle"
"{"
"key = \"UF\" ;"
"label = \"指定文件夹\" ;"
"}"
":button"
"{"
"key = \"SEL\";"
"label = \"打开(&O)\";"
"}"
"}"
":text"
"{"
"key = \"PATH\" ;"
"label = \"\" ;"
"}"
"}"
"}"
":boxed_column"
"{"
"label = \"文件列表\"; "
"fixed_width = true;"
"width = 60;"
":list_box"
"{"
"key = \"LST\";"
"multiple_select = true;"
"}"
"}"
"}"
":row"
"{"
"spacer;"
"ok_cancel_help;"
"spacer_1;"
"space

r_1;"
"spacer_1;"
":button"
"{"
"key = \"SHOW\" ;"
"label = \"显示(&S)\" ;"
"fixed_width = true;"
"width = 12;"
"}"
":toggle"
"{"
"key = \"SUB\" ;"
"label = \"包括子目录(&I)\" ;"
"value = \"1\";"
"}"
":toggle"
"{"
"key = \"SA\" ;"
"label = \"全选(&A)\" ;"
"}"
":toggle"
"{"
"key = \"DA\" ;"
"label = \"清选(&D)\" ;"
"}"
"spacer;"
"}"
"}"
)
(write-line str file)
)
(close file)
Dcl_File
)