（XD::DOC:Directorylist）目录（子目录）指定文件类型列表

newer · 发表于 2017-3-28 23:24:26

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

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

×

本帖最后由 newer 于 2017-3-29 00:48 编辑

(defun xd::doc:directorylist (location filetype mode / dirlist path allpath)
(defun makedirlist (arg / tmplist)
(setq tmplist (cddr (vl-directory-files arg nil -1)))
(cond
(tmplist (setq dirlist (append
dirlist
(mapcar
'(lambda (z)
(strcat arg "\\" z)
)
tmplist
)
)
)
(foreach item tmplist
(makedirlist (strcat arg "\\" item))
)
)
)
)
(if (not mode)
(progn
(mapcar
'(lambda (x)
(strcat location (if (not (member (substr location
(strlen location) 1
) (list "/" "\\")
)
)
"\\"
""
) x
)
)
(vl-directory-files location (strcat "*." filetype) 1)
)
)
(progn
(makedirlist location)
(setq dirlist (cons location dirlist))
(foreach elem dirlist
(if (setq path (vl-directory-files elem (strcat "*." filetype)))
(foreach item path
(setq allpath (cons (strcat elem (if (not (member
(substr elem
(strlen elem)
1
)
(list "/" "\\")
)
)
"\\"
""
) item
) allpath
)
)
)
)
)
(reverse allpath)
)
)
)

(defun xd::doc:directorylist (location filetype mode / dirlist path allpath) 
  (defun makedirlist (arg / tmplist) 
    (setq tmplist (cddr (vl-directory-files arg nil -1))) 
    (cond 
      (tmplist (setq dirlist (append 
                               dirlist 
                               (mapcar 
                                 '(lambda (z) 
                                    (strcat arg "\\" z) 
                                  ) 
                                 tmplist 
                               ) 
                             ) 
               ) 
               (foreach item tmplist 
                 (makedirlist (strcat arg "\\" item)) 
               ) 
      ) 
    ) 
  ) 
  (if (not mode) 
    (progn 
      (mapcar 
        '(lambda (x) 
           (strcat location (if (not (member (substr location 
                                                     (strlen location) 1 
                                             ) (list "/" "\\") 
                                     ) 
                                ) 
                              "\\" 
                              "" 
                            ) x 
           ) 
         ) 
        (vl-directory-files location (strcat "*." filetype) 1) 
      ) 
    ) 
    (progn 
      (makedirlist location) 
      (setq dirlist (cons location dirlist)) 
      (foreach elem dirlist 
        (if (setq path (vl-directory-files elem (strcat "*." filetype))) 
          (foreach item path 
            (setq allpath (cons (strcat elem (if (not (member 
                                                              (substr elem 
                                                                      (strlen elem) 
                                                                      1 
                                                              ) 
                                                              (list "/" "\\") 
                                                      ) 
                                                 ) 
                                               "\\" 
                                               "" 
                                             ) item 
                                ) allpath 
                          ) 
            ) 
          ) 
        ) 
      ) 
      (reverse allpath) 
    ) 
  ) 
)

qxlonmsn · 发表于 2022-5-26 10:13:51

感谢大佬的代码

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

[[coior=red]文档类] （XD::DOC:Directorylist）目录（子目录）指定文件类型列表

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