2024年3月10日发(作者：)
CAD清理垃圾源代码.txt我退化了，到现在我还不会游泳，要知道在我出生之前，我绝对是
游的最快的那个(vl-load-com)
(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 "ation")) ;ation
对象
(setq fs (vlax-create-object "stemObject")) ;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 value / 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))
)
)
发布评论