设为首页收藏本站CAD论坛CAD教程CAD下载明经币充值
切换到宽版

明经CAD社区

 找回密码
 注册

QQ登录

只需一步，快速开始

搜索
明经CAD社区»社区 › 开发篇 › AutoLISP/Visual LISP 编程技术 › 【求助】列出给定目录中的所有文件，包含二级三级N级目 ...
返回列表 发新帖
查看: 2020|回复: 9

[函数] 【求助】列出给定目录中的所有文件，包含二级三级N级目录【在线等急！谢谢】

[复制链接]
zark
发表于 2011-4-12 16:39 | 显示全部楼层 |阅读模式
VLISP 有个函数vl-directory-files       列出给定目录中的所有文件
这个函数只列出当前目录下的文件，如果存在下一级目录就不支持了
想了好久还是解决不了多级目录的问题
在线请教高手高高手提供点思想或者现成的LISP
在此不甚感激！！！
回复

使用道具 举报

Andyhon
发表于 2011-4-12 17:41 | 显示全部楼层
is this help
http://forums.autodesk.com/t5/Vi ... ry-tree/m-p/1875326
回复 支持 反对

使用道具 举报

yxl88168
发表于 2011-4-12 18:21 | 显示全部楼层
我有一个软件有那个功能，但没有lsp的，要的话和我联系
回复 支持 反对

使用道具 举报

zark
 楼主| 发表于 2011-4-12 19:01 | 显示全部楼层
回复 Andyhon 的帖子

谢谢谢谢，这正是我需要的，好好学习，再好好研究，谢谢，感觉有你
回复 支持 反对

使用道具 举报

highflybird
发表于 2011-4-13 00:02 | 显示全部楼层
本帖最后由 highflybird 于 2011-4-13 12:15 编辑

关于遍历文件夹的问题，其实我已经在我的ActiveX和脚本技术的那个帖子中讲到了，用的是Shell.application方法。
http://bbs.mjtd.com/thread-85042-1-1.html

这里我再给出一种API方法，速度相当快。需要DynamicWrapper 的支持。
另外我的帖子《CAD垃圾文件清理工具》中也用到了这样的方法。
http://bbs.mjtd.com/thread-85033-1-5.html
  1. ;;;测试程序------------------------------------------------------------
  2. (defun c:test(/ DIRPATH HWND LST *PATH *SHELL)
  3.   (setq hwnd (vla-get-hwnd (vlax-get-acad-object)))
  4.   (setq *shell (vlax-create-object "Shell.Application"))
  5.   (setq *path  (vlax-invoke *shell 'BrowseForFolder 0 "请选择一个文件夹" 4471))
  6.   (if (setq DIrPath (vlax-get (vlax-get *path 'self) 'path))
  7.     (setq lst (ForeachFolder DirPath))
  8.   )
  9.   (vlax-release-object *path)
  10.   (vlax-release-object *shell)
  11.   (princ)
  12. )
  13. ;;;搜索程序-------------------------------------------------------------
  14. (defun ForeachFolder(path / DWX buffer fLst fSize NumDir SINFO SNUMD SNUMF TIME)
  15.   (setq DWX (vlax-create-object "DynamicWrapperX"))   ;创建DynamicWrapperX
  16.   ;; File find operation
  17.   (vlax-invoke DWX 'Register "KERNEL32" "FindFirstFileW" "i=wp" "r=l")
  18.   (vlax-invoke DWX 'Register "KERNEL32" "FindNextFileW" "i=lp" "r=l")
  19.   (vlax-invoke DWX 'Register "KERNEL32" "FindClose" "i=l" "r=l")
  20.   (vlax-invoke DWX 'Register "SHLWAPI" "PathFileExistsW" "i=w" "r=l")
  21.   ;; memory
  22.   (vlax-invoke DWX 'Register "MSVCRT" "malloc" "i=l" "r=p")
  23.   (vlax-invoke DWX 'Register "MSVCRT" "calloc" "i=ll" "r=p")
  24.   (vlax-invoke DWX 'Register "MSVCRT" "free" "i=p")
  25.   ;; search get started
  26.   (if (/= (vlax-invoke DWX 'PathFileExistsW path) 0)   ;如果目录名有效
  27.     (progn
  28.       (setq FLst nil)       ;文件名列表
  29.       (setq fSize 0.)       ;文件总大小
  30.       (setq NumDir 1)       ;目录总数，加上开始部分目录
  31.       (setq time (getvar "TDUSRTIMER"))     ;开始计时
  32.       (setq buffer (vlax-invoke DWX 'calloc 1 592))    ;为文件搜索数据开辟缓冲区
  33.       (if (/= (substr path (strlen path)) "\\")
  34.         (setq path (strcat path "\\"))
  35.       )
  36.       (Search path)
  37.       (vlax-invoke DWX 'free buffer)     ;释放缓冲区
  38.       (setq time  (rtos (* (- (getvar "TDUSRTIMER") time) 86400))) ;结束计时
  39.       (setq time  (strcat "\n搜索时间: " time " 秒."))
  40.       (setq sNumF (strcat "找到: " (itoa (length FLst)) " 个文件. "))
  41.       (setq sNumD (strcat (itoa NumDir) " 个目录."))
  42.       (setq fSize (/ fSize 1048576))
  43.       (setq fSize (strcat "总大小: " (rtos fSize) " M."))
  44.       (setq sInfo (strcat Time sNumF sNumD fSize))   ;统计信息
  45.       (princ sInfo)
  46.       (and DWX (vlax-release-object DWX))    ;释放DynamicWrapperX
  47.       (setq FLst (reverse FLst))
  48.     )
  49.   )         
  50. )
  51. ;;;搜索符合过滤条件的文件-----------------------------------------------
  52. ;;;FLST,FSIZE,NumDir,buffer are global varialbes------------------------
  53. (defun Search (Folder / DLst H Cont fName att lSize hSize)  
  54.   (setq H (vlax-invoke DWX 'FindFirstFileW (strcat Folder "*") buffer)) ;找第一个文件的句柄
  55.   (if (/= H -1)        ;如果找到了
  56.     (progn               
  57.       (while (/= Cont 0)           ;开始重复下面的步骤
  58. (setq fName (vlax-invoke DWX 'StrGet (+ buffer 44)))  ;获取文件名
  59. (if (and (/= fName ".") (/= fName ".."))   ;不能是.和..(根目录，子目录)两个特殊的目录名
  60.    (progn
  61.      (setq att (vlax-invoke DWX 'NumGet buffer))   ;文件的属性
  62.      (if (= (logand att 16) 0)     ;符合这样的是文件名，在这里你可以加入自己的检查
  63.        (progn
  64.   (setq hSize (vlax-invoke DWX 'NumGet buffer 28)) ;高字节为超过4G的文件尺寸
  65.          (setq lSize (vlax-invoke DWX 'NumGet buffer 32)) ;低字节为小于4G的文件尺寸
  66.   (setq fName (strcat Folder fName))   ;则把路径也连起来
  67.   (setq FLst (cons fName FLst))    ;加入文件表
  68.   (if (= hSize 0)
  69.     (setq fSize (+ lSize fSize))    ;小于4G的文件
  70.     (setq fSize (+ lSize (* hSize 4294967296) fSize)) ;大于4G的文件
  71.   )
  72.        )
  73.        (progn
  74.   (setq fName (strcat Folder fName "\\"))   ;后面加上\
  75.          (setq DLst (cons fName DLst))
  76.   (setq NumDir (1+ NumDir))    ;目录计数加1
  77.        )
  78.      )
  79.    )
  80. )
  81. (setq Cont (vlax-invoke DWX 'FindNextFileW H buffer))  ;查找下一个
  82.       )
  83.       (setq Cont (vlax-invoke DWX 'FindClose H))   ;查找关闭
  84.     )
  85.   )      
  86.   (foreach Dir (reverse DLst)      ;如果要递归查找
  87.     (Search Dir)
  88.   )
  89. )




回复 支持 反对

使用道具 举报

啵浪鼓
发表于 2011-4-13 00:26 | 显示全部楼层
楼上的为何执行后:
命令: test ; 错误: 参数类型错误: VLA-OBJECT nil
回复 支持 反对

使用道具 举报

highflybird
发表于 2011-4-13 07:28 | 显示全部楼层
回复 啵浪鼓 的帖子

我已经说明了，需要DynamicWrapperX的支持。


这两个文件随便下载一个就可以了，只要注册一下就行。

本帖子中包含更多资源

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

x
回复 支持 反对

使用道具 举报

zark
 楼主| 发表于 2011-4-13 08:07 | 显示全部楼层
回复 highflybird 的帖子

谢谢~！
(defun TreeSearch (root pattern / Recurse Result)
  (defun Recurse (root pattern / Files Directories)
    (setq Files              (mapcar '(lambda (x) (strcat root "\\" x))
                              (vl-directory-files root pattern 1)
                      )
          Directories (mapcar '(lambda (x) (strcat root "\\" x))
                              (vl-remove-if
                                '(lambda (x) (member x '("." "..")))
                                (vl-directory-files root nil -1)
                              )
                      )
    )
    (foreach file Files (setq Result (cons (strcase file) Result)))
    (foreach directory Directories (Recurse directory pattern))
  )
  (Recurse root pattern)
  Result
)
回复 支持 反对

使用道具 举报

zml84
发表于 2011-4-27 13:06 | 显示全部楼层
http://zml84.blog.sohu.com/161181681.html
回复 支持 反对

使用道具 举报

yyszpp
发表于 2011-6-3 23:57 | 显示全部楼层
回复 highflybird 的帖子

又是你，，，顶  坚决顶 ，，看见你头像我就兴奋，，，，谢谢 这个也是我要找的，，，
回复 支持 反对

使用道具 举报

返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码，在未取得本站及作者授权的情况下，不得用于商业用途

GMT+8, 2024-5-18 22:21 , Processed in 0.359759 second(s), 26 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表