如何遍历某目录下所有CAD文件

dzgsfjw · 发表于 2014-7-23 11:38:24

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

如何遍历某目录下所有CAD文件，也包括子目录下的DWG。

Underway · 发表于 2014-7-23 13:57:22

;;; By Elpanov Evgeniy
;;; (getfile "*.Dwg" "D:\\Dwg")

(defun GetFile (f p)
(apply
'append
(cons
(if (vl-directory-files p f)
(mapcar
'(lambda (x) (strcat p "\" x))
(vl-directory-files p f)
)
)
(mapcar
'(lambda (x) (GetFile f (strcat p "\" x)))
(vl-remove
".."
(vl-remove
"."
(vl-directory-files p nil -1)
)
)
)
)
)
)
(defun GetFirstFile (f p)
;; By ElpanovEvgeniy
;; (GetFirstFile "a?ad.exe" '("C:\\Program Files"))
(cond
((not p) nil)
((vl-directory-files (car p) f)
(strcat (car p) "\" (car (vl-directory-files (car p) f)))
)
((GetFirstFile
f
(append
(mapcar
(function (lambda (x) (strcat (car p) "\" x)))
(vl-remove ".."
(vl-remove "." (vl-directory-files (car p) nil-1))
)
) ;_ mapcar
(cdr p)
) ;_ append
) ;_ GetFirstFile
)
) ;_ cond
) ;_ defun

(defun GetFile (f p) 
  (apply 
    'append 
    (cons 
      (if (vl-directory-files p f) 
        (mapcar 
         '(lambda (x) (strcat p "\" x)) 
          (vl-directory-files p f) 
        ) 
      ) 
      (mapcar 
       '(lambda (x) (GetFile f (strcat p "\" x))) 
        (vl-remove 
          ".." 
          (vl-remove 
            "." 
            (vl-directory-files p nil -1) 
          ) 
        ) 
      ) 
    ) 
  ) 
) 
 
(defun GetFirstFile (f p) 
  ;; By ElpanovEvgeniy 
  ;; (GetFirstFile "a?ad.exe" '("C:\\Program Files")) 
  (cond 
    ((not p) nil) 
    ((vl-directory-files (car p) f) 
     (strcat (car p) "\" (car (vl-directory-files (car p) f))) 
    ) 
    ((GetFirstFile 
       f 
       (append 
         (mapcar 
           (function (lambda (x) (strcat (car p) "\" x))) 
           (vl-remove ".." 
                      (vl-remove "." (vl-directory-files (car p) nil-1)) 
           ) 
         ) ;_ mapcar 
         (cdr p) 
       ) ;_ append 
     ) ;_ GetFirstFile 
    ) 
  ) ;_ cond 
) ;_ defun

czx663 · 发表于 2014-7-23 14:58:51

用vl-directory-files返回一个列表,挨个处理不就行了吗?

czx663 · 发表于 2014-7-23 15:39:54

我想简单了。楼上高手

czx663 · 发表于 2014-7-26 23:55:33

今天琢磨了一个,请高手指正.这个代码只是输出文件名,如果要做操作,可修改相应的outPutFileList函数

czx663 · 发表于 2014-7-26 23:56:37

本帖最后由 czx663 于 2014-7-27 00:48 编辑

;|功能:遍历文件夹下及子文件夹的某类文件
参数: FileName 寻找文件的块名
Path 指定的目录路径
|;
(setq DirList (list "*@")) ;定义一个非空的公共变量,临时储存文件目录
(defun getFile (FileName Path / MyErr
DirListBak FileListTemp DirListTemp Ent
NewPath DirListTempBak
)
(defun MyErr (Msg)
(setq DirList (list "*@"))
(close f)
(alert Msg)
) ;defun MyErr
(setq MyErr *Error*)
(if (not DirList)
(progn
(setq DirList (list "*@"))
(exit)
) ;progn
) ;if
(if (member "*@" DirList)
(setq DirList (vl-remove "*@" DirList))
) ;if
(setq DirListBak DirList) ;全局变量的备份
(if (not DirList)
(progn
(setq FileListTemp (vl-directory-files Path FileName 1))
;指定目录下的文件列表
(if (not FileListTemp)
(outPutFileList (strcat Path "下没有" FileName "文件"))
(progn
(outPutFileList Path)
(outPutFileList FileListTemp)
) ;progn
) ;if
(setq DirListTemp
(vl-remove
"."
(vl-remove ".." (vl-directory-files Path nil -1))
)
) ;指定目录下的目录列表
(if (not DirListTemp)
(exit)
(setq DirListBak DirListTemp)
) ;if
) ;progn
) ;if
(foreach ent DirList
(setq NewPath (strcat Path "\" Ent))
(setq FileListTemp (vl-directory-files NewPath FileName 1))
;指定目录下的文件列表
(if (not FileListTemp)
(outPutFileList (strcat NewPath "下没有" FileName "文件"))
(progn
(outPutFileList NewPath)
(outPutFileList FileListTemp)
) ;progn
) ;if
(setq DirListTemp
(vl-remove
"."
(vl-remove ".." (vl-directory-files NewPath nil -1))
)
) ;指定目录下的目录列表
(setq DirListTempBak DirListTemp)
(if (not DirListTemp)
(setq DirListBak (vl-remove Ent DirListBak))
(progn
(foreach Ent1 DirListTemp
(setq EntTemp (strcat Ent "\" Ent1))
(setq DirListTempBak (subst EntTemp Ent1 DirListTempBak))
) ;foreach
(setq DirListBak (insertList DirListBak DirListTempBak Ent))
) ;progn
) ;if
) ;foreach
(setq DirList DirListBak)
(getFile FileName Path)
) ;defun getFile
;|功能:将文本输出到文件
参数:Str :要输出的文本
|;
(defun outPutFileList (Str / f)
(setq f (open "d:\\FileList.txt" "a"))
(write-line (vl-prin1-to-string Str) f)
(close f)
) ;defun
;|功能:将一个列表中一个元素替换
参数: Lst 保存的列表类型:列表
Atoms 插入元素列表类型:列表
PosAtoms Lst中指定位置的被替换元素类型:元素
|;
(defun insertList (Lst Atoms PosAtoms / FrontLst BehindLst)
(if (member PosAtoms Lst)
(progn
(setq FrontLst (reverse (cdr (member PosAtoms (reverse Lst)))))
(setq BehindLst (cdr (member PosAtoms Lst)))
(setq Lst (append FrontLst Atoms BehindLst))
) ;progn
(alert "输入的插入点有误")
) ;if
Lst
) ;defun insertList

;|功能:遍历文件夹下及子文件夹的某类文件 
参数: FileName  寻找文件的块名 
      Path      指定的目录路径 
|; 
 
(setq DirList (list "*@"))                ;定义一个非空的公共变量,临时储存文件目录 
(defun getFile (FileName     Path          /               MyErr 
                DirListBak   FileListTemp DirListTemp  Ent 
                NewPath             DirListTempBak 
               ) 
  (defun MyErr (Msg) 
    (setq DirList (list "*@")) 
    (close f) 
    (alert Msg) 
  )                                        ;defun MyErr 
  (setq MyErr *Error*) 
  (if (not DirList) 
    (progn 
      (setq DirList (list "*@")) 
      (exit) 
    )                                        ;progn 
  )                                        ;if 
  (if (member "*@" DirList) 
    (setq DirList (vl-remove "*@" DirList)) 
  )                                        ;if 
 
  (setq DirListBak DirList)                ;全局变量的备份 
  (if (not DirList) 
    (progn 
      (setq FileListTemp (vl-directory-files Path FileName 1)) 
                                        ;指定目录下的文件列表 
      (if (not FileListTemp) 
        (outPutFileList (strcat Path "下没有" FileName "文件")) 
        (progn 
          (outPutFileList Path) 
          (outPutFileList FileListTemp) 
        )                                ;progn 
      )                                        ;if 
 
      (setq DirListTemp 
             (vl-remove 
               "." 
               (vl-remove ".." (vl-directory-files Path nil -1)) 
             ) 
      )                                        ;指定目录下的目录列表 
      (if (not DirListTemp) 
        (exit) 
        (setq DirListBak DirListTemp) 
      )                                        ;if 
 
    )                                        ;progn 
  )                                        ;if 
 
 
  (foreach ent DirList 
    (setq NewPath (strcat Path "\" Ent)) 
    (setq FileListTemp (vl-directory-files NewPath FileName 1)) 
                                        ;指定目录下的文件列表 
    (if        (not FileListTemp) 
      (outPutFileList (strcat NewPath "下没有" FileName "文件")) 
      (progn 
        (outPutFileList NewPath) 
        (outPutFileList FileListTemp) 
      )                                        ;progn 
    )                                        ;if 
 
    (setq DirListTemp 
           (vl-remove 
             "." 
             (vl-remove ".." (vl-directory-files NewPath nil -1)) 
           ) 
    )                                        ;指定目录下的目录列表 
    (setq DirListTempBak DirListTemp) 
    (if        (not DirListTemp) 
      (setq DirListBak (vl-remove Ent DirListBak)) 
      (progn 
        (foreach Ent1 DirListTemp 
          (setq EntTemp (strcat Ent "\" Ent1)) 
          (setq DirListTempBak (subst EntTemp Ent1 DirListTempBak)) 
        )                                ;foreach 
        (setq DirListBak (insertList DirListBak DirListTempBak Ent)) 
      )                                        ;progn 
 
    )                                        ;if 
 
  )                                        ;foreach 
  (setq DirList DirListBak) 
  (getFile FileName Path) 
)                                        ;defun getFile 
 
 
 
;|功能:将文本输出到文件 
参数:Str :要输出的文本 
|; 
(defun outPutFileList (Str / f) 
  (setq f (open "d:\\FileList.txt" "a")) 
  (write-line (vl-prin1-to-string Str) f) 
  (close f) 
)                                        ;defun 
 
 
;|功能:将一个列表中一个元素替换 
参数:   Lst    保存的列表     类型:列表 
        Atoms  插入元素列表   类型:列表 
        PosAtoms Lst中指定位置的被替换元素  类型:元素 
|; 
(defun insertList (Lst Atoms PosAtoms / FrontLst BehindLst) 
  (if (member PosAtoms Lst) 
    (progn 
      (setq FrontLst (reverse (cdr (member PosAtoms (reverse Lst))))) 
      (setq BehindLst (cdr (member PosAtoms Lst))) 
      (setq Lst (append FrontLst Atoms BehindLst)) 
    )                                        ;progn 
    (alert "输入的插入点有误") 
  )                                        ;if 
  Lst 
)                                        ;defun insertList

dzgsfjw · 发表于 2014-7-27 15:20:33

谢谢 Underway，测试成功。

也谢谢czx663的热心

账号		自动登录	找回密码
密码			立即注册

[求助] 如何遍历某目录下所有CAD文件

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子