- (defun qf_getFolder (msg / WinShell shFolder path catchit)
- (vl-load-com)
- (setq winshell (vlax-create-object "Shell.Application"))
- (setq shFolder (vlax-invoke-method WinShell 'BrowseForFolder 0 msg 1))
- (setq
- catchit (vl-catch-all-apply
- '(lambda ()
- (setq shFolder (vlax-get-property shFolder 'self))
- (setq path (vlax-get-property shFolder 'path))
- )
- )
- )
- (if (vl-catch-all-error-p catchit)
- nil
- path
- )
- )
- ;|函数功能: 获取目录下(包含子目录)里的某类型文件
- ;使用格式: a为路径名或多个路劲名表,b为扩展名
- ;范 例: (n5-get-files "D:" "lsp"),搜索d盘中所有lsp文件|;
- ;(setq c(n5-get-files b "dat"))
- ;(vl-file-directory-p b)返回T
- ;2016-6-11
- ;095
- (defun n5-get-files(a b / lst mulu wj x )
- (setq lst '())
- (cond
- ((= (type a)'STR)
- (if (setq wj (mapcar '(lambda(x)(strcat a "\" x))(vl-directory-files a (strcat"*." b))))
- (setq lst (cons wj lst)))
- (if (setq mulu (mapcar '(lambda(x)(strcat a "\" x))(cddr(vl-directory-files a nil -1))))
- (foreach x mulu(setq lst(cons(n5-get-files x b) lst)))
- )
- )
- ((= (type a) 'list) (foreach x a (setq lst (cons(n5-get-files x b)lst))))
- )
- (reverse(apply 'append lst))
- )
- (defun lst-(l1 l2)(if l2(foreach x l2(setq l1(vl-remove x l1)))l1))
- (defun c:tt( / *DBX* DBX DOC FILENAME FILENAME1 FILES LAYS MSP PATH)
- (setq *dbx* (strcat "ObjectDBX.AxDbDocument."(substr (getvar "acadver") 1 2)))
- (setq lst'("Pipe_APP_P" "Device_Point"))
- (setq path(QF_GETFOLDER"选择文件夹"))
- (setq files(N5-GET-FILES path "dwg"))
- ;;; (setq fp(open "c:\\你微笑时很美.txt" "w"))
- (foreach file files
- (write-line (strcat "当前冻结图层文件:"file))
- (setq filename(VL-FILENAME-MKTEMP nil nil ".dwg"))
- (vl-file-copy file filename)
- (setq dbx(vlax-get-or-create-object *dbx*))
- (vla-open dbx filename)
- (setq msp(vla-get-ModelSpace dbx))
- ;;; (vlax-for obj msp(vla-put-color obj 256))
- (setq doc(vlax-get msp 'Document))
- (setq lays(vla-get-layers doc))
- (vlax-for lay lays(if (member (vla-get-name lay)lst) (vla-put-Freeze lay :vlax-true)))
- (setq filename1(VL-FILENAME-MKTEMP nil nil ".dwg"))
- (vlax-invoke dbx 'saveas filename1)
- (vlax-release-object dbx)
- (vl-file-delete file)
- (vl-file-copy filename1 file)
- (vl-file-delete filename1)
- )
- ;;; (close fp)
- ;;; (startapp"notepad" "c:\\你微笑时很美.txt")
- (princ)
- )
|