Тема: LISP.LIB Поиск файлов, список папок...

 ;|
 Функция поиска всех папок внутри указанных в списке корневых папок.
 Аргументы:
 P - список корневых папок.
 например '("C:\\Program Files") или '("C:" "D:" "E:")
 Вызывать
 (GetFolders '("C:\\Program Files\\AutoCAD 2004\\Sample"))
 Возвращает список папок, включая указанные в списке поиска.
 '("C:\\Program Files\\AutoCAD 2004\\Sample"
    "C:\\Program Files\\AutoCAD 2004\\Sample\\ActiveX"
    "C:\\Program Files\\AutoCAD 2004\\Sample\\Database Connectivity"
    "C:\\Program Files\\AutoCAD 2004\\Sample\\DesignCenter"
    "C:\\Program Files\\AutoCAD 2004\\Sample\\VBA"
    "C:\\Program Files\\AutoCAD 2004\\Sample\\VisualLISP"
    "C:\\Program Files\\AutoCAD 2004\\Sample\\ActiveX\\ExtAttr"
    "C:\\Program Files\\AutoCAD 2004\\Sample\\ActiveX\\ExternalCall"
    "C:\\Program Files\\AutoCAD 2004\\Sample\\Database Connectivity\\CAO"
    "C:\\Program Files\\AutoCAD 2004\\Sample\\VBA\\VBAIDEMenu"
    "C:\\Program Files\\AutoCAD 2004\\Sample\\VisualLISP\\activex"
    "C:\\Program Files\\AutoCAD 2004\\Sample\\VisualLISP\\External"
    "C:\\Program Files\\AutoCAD 2004\\Sample\\VisualLISP\\mdi-vlx"
    "C:\\Program Files\\AutoCAD 2004\\Sample\\VisualLISP\\reactors"
   )
|;
(defun GetFolders (p)
 ;; By ElpanovEvgeniy
 ;; (GetFolders '("C:\\Program Files\\AutoCAD 2004\\Sample"))
 (if p
  (append
   p
   (GetFolders
    (apply (function append)
           (mapcar
            (function (lambda (b)
                       (mapcar (function (lambda (a) (strcat b "\\" a)))
                               (vl-remove ".."
                                          (vl-remove "." (vl-directory-files b nil -1))
                               )
                       )
                      )
            )
            p
           )
    )
   )
  )
 )
)
 ;|
 Функция поиска файла или файлов в указанной папке и всех вложенных папках
 файл задается именем или маской
 Аргументы:
 P - начальный путь поиска,
 например "C:" или "C:\\Program Files"
 F - название файла,
 возможно использование подстановочных символов.
 например
 "*.dwg" - найдет все dwg-файлы
 или "acad*.lsp"
 Вызывать
 (getfile "acad*.lsp" "C:\\Program Files")
 Возвращает список файлов с полным путем до них и названием без маски.
 '("C:\\Program Files\\AutoCAD 2004\\Express\\acadinfo.lsp"
    "C:\\Program Files\\AutoCAD 2004\\Support\\acad2004.lsp"
    "C:\\Program Files\\AutoCAD 2004\\Support\\acad2004doc.lsp"
    "C:\\Program Files\\AutoCAD 2004\\Support\\acadinfo.lsp"
  )
|;
(defun GetFile (f p)
 ;; By ElpanovEvgeniy
 ;; (getfile "acad*.lsp" "C:\\Program Files")
 (apply (function append)
        (cons (if (vl-directory-files p f)
               (mapcar (function (lambda (x) (strcat p "\\" x))) (vl-directory-files p f))
              ) ;_ if
              (mapcar (function (lambda (x) (GetFile f (strcat p "\\" x))))
                      (vl-remove ".." (vl-remove "." (vl-directory-files p nil -1)))
              ) ;_ mapcar
        ) ;_ cons
 ) ;_ apply
)
;|
 Функция поиска файла  внутри указанных в списке корневых папок
 и всех вложенных папках
 Поиск останавливается на первом указанном файле
 файл задается именем или маской
 По сравнению с функцией GetFile работает быстрее,
 т.к. прерывает поиск, после нахождения файла.
 Рекомендуется для поиска файлов с уникальным названием.
 Аргументы:
 P - список корневых папок.
 например '("C:\\Program Files") или '("C:" "D:" "E:")
 F - название файла,
 возможно использование подстановочных символов.
 например:
 "a?ad.exe"
 Вызывать:
 (GetFirstFile "a?ad.exe" '("C:\\Program Files"))
 Возвращает строку - полный путь к файлу с полным названием.
"C:\\Program Files\\AutoCAD 2004\\acad.exe"
|;
(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
;|
Если установлен "AutoCAD Express Tools"
можно использовать встроенную функцию.
ACET-FILE-DIR
Аргументы
1 - Строка - название искомого файла или файлов, возможны подстановочные символы
например: "a?ad.exe" или "*.lsp"
2 - Строка - корневая папка поиска
например: "C:" или "C:\\Program Files"
|;
(ACET-FILE-DIR "a?ad.exe" "C:\\Program Files")
;; вернет:
'
 ("C:\\Program Files\\AutoCAD 2004\\acad.exe")
(ACET-FILE-DIR "acad*.lsp" "C:\\Program Files")
;; вернет:
'
 ("C:\\Program Files\\AutoCAD 2004\\Express\\acadinfo.lsp"
  "C:\\Program Files\\AutoCAD 2004\\Support\\acad2004.lsp"
  "C:\\Program Files\\AutoCAD 2004\\Support\\acad2004doc.lsp"
  "C:\\Program Files\\AutoCAD 2004\\Support\\acadinfo.lsp"
 )

Re: LISP.LIB Поиск файлов, список папок...

PS. забыл добавить, ссылку на первоисточник (на французском)...
http://www.cadxp.com/modules.php?op=mod … ;tid=13600

Re: LISP.LIB Поиск файлов, список папок...

https://www.caduser.ru/forum/topic25094.html