Topic: List Sub-Directories within a Directory

[deegeecees]

Been quite a while since I've hacked away in Lisp, but I'm looking for a way to list the sub-directories in a given directory. Fairly easy and straight forward. I've looked at the vl- functions but nothing seems to jump out at me. Could someone point me in the right direction?

[gile]

Hi,

IMO, Vanilla LISP (DXF) is a better way with dictionaries.

Here's a little routine which returns an assoc list of all entries of the specified dictionary. Each pair is of type (key . ename).
Warning, Dictionariy entries may be either dictionaries or xrecords or custom objects.

Code - Auto/Visual Lisp: [Select]

1. (defun gc:GetDictEntries (dict / result)
2.   (and (= (type dict) 'ENAME) (setq dict (entget dict)))
3.   (while
4.     (setq dict (vl-member-if (function (lambda (x) (= (car x) 3))) (cdr dict)))
5.      (setq result (cons (cons (cdar dict) (cdadr dict)) result))
6.   )
7.   (reverse result)
8. )

[BlackBox]

You could use Scripting.FileSystemObject Object:

Code - Auto/Visual Lisp: [Select]

1. (defun _GetSubFolders (oFolder / oSubs)
2.   (if (< 0
3.             (vlax-get
4.               (setq oSubs (vlax-get oFolder 'subfolders))
5.               'count
6.             )
7.          )
8.     (vlax-for x oSubs
9.       (setq subFolders (cons (vlax-get x 'path) subFolders))
10.       (_GetSubFolders x)
11.     )
12.   )
13. )

[BlackBox]

Quick example:

Code - Auto/Visual Lisp: [Select]

1. (defun c:FOO (/ *error* _GetSubFolders acApp oShell oShellFolder path
2.               oFso oFolder subFolders
3.              )
4.  
5.   (defun *error* (msg)
6.     (if oShell
7.       (vlax-release-object oShell)
8.     )
9.     (if oFso
10.       (vlax-release-object oFso)
11.     )
12.     (cond ((not msg))                                                   ; Normal exit
13.           ((member msg '("Function cancelled" "quit / exit abort")))    ; <esc> or (quit)
14.           ((princ (strcat "\n** Error: " msg " ** ")))                  ; Fatal error, display it
15.     )
16.     (princ)
17.   )
18.  
19.   (defun _GetSubFolders (oFolder / oSubs)
20.     (if (< 0
21.            (vlax-get
22.              (setq oSubs (vlax-get oFolder 'subfolders))
23.              'count
24.            )
25.         )
26.       (vlax-for x oSubs
27.         (setq subFolders (cons (vlax-get x 'path) subFolders))
28.         (_GetSubFolders x)
29.       )
30.     )
31.   )
32.  
33.   (if (and (setq acApp (vlax-get-acad-object))
34.            (setq oShell (vla-getinterfaceobject acApp "Shell.Application"))
35.            (setq oShellFolder
36.                   (vlax-invoke
37.                     oShell
38.                     'BrowseForFolder
39.                     (vla-get-hwnd acApp)
40.                     "Select a folder to add to SFSP:"
41.                     0
42.                     17
43.                   )
44.            )
45.            (setq path (vlax-get-property
46.                         (vlax-get-property oShellFolder 'Self)
47.                         'Path
48.                       )
49.            )
50.            (setq oFso
51.                   (vla-getinterfaceobject acApp "Scripting.FileSystemObject")
52.            )
53.            (setq oFolder (vlax-invoke oFso 'getfolder path))
54.            (not (_GetSubFolders oFolder))
55.            subFolders
56.       )
57.     (progn
58.       (prompt "\nSub-Folders found: \n")
59.       (foreach sub subFolders
60.         (prompt (strcat "\n\t\t" sub))
61.       )
62.       (terpri)
63.       (*error* nil)
64.     )
65.     (cond (oFolder (*error* "No subfolders found"))
66.           (oFso (*error* "Unable to obtain Folder Object"))
67.           (path
68.            (*error*
69.              "Unable to create \"Scripting.FileSystemObject\" Object"
70.            )
71.           )
72.           (oShellFolder (*error* "Unable to obtain path property"))
73.           (oShell (*error* "No directory selected"))
74.           (acApp
75.            (*error* "Unable to create \"Shell.Application\" Object")
76.           )
77.     )
78.   )
79. )

[gile]

Oopss !! I confused Directory and dictionary  :ugly:

Look at the vl-directory-files function with -1 flag.

[chlh_jd]

following's code written by xyp-1964

Code: [Select]

(defun xyp-GetFolders (path SubFolders-TNil / main sub folder)
  (defun main (path / folders)
    (if (member "." (setq folders (vl-directory-files path nil -1)))
      (cddr folders)
      folders
    )
  )
  (defun sub (path)
    (mapcar (function (lambda (folder / temp)
       (cons (setq temp (strcat path "/" folder))
     (apply 'append (sub temp))
       )
     ))
    (main path)
    )
  )
  (if (setq lst
     (if SubFolders-TNil
       (apply (function append) (sub path))
       (if (setq folders (main path))
(mapcar (function (lambda (x) (strcat path "/" x))) folders)
       )
     )
      )
    (vl-sort (mapcar (function strcase) lst) (function <))
  )
)


[irneb]

Here's my version (also using vl-directory-files):

Code - Auto/Visual Lisp: [Select]

1. (defun _GetSubfolders (path / )
2.   (setq path (vl-string-right-trim "\\/" path))
3.   (mapcar '(lambda (name) (strcat path "\\" name))
4.           (vl-remove-if '(lambda (name) (wcmatch name "`.,`.`."))
5.             (vl-directory-files path nil -1))))
6.  
7. (defun _GetRecursiveSubfolders (path /)
8.   (setq path (vl-string-right-trim "\\/" path))
9.   (apply 'append
10.          (mapcar '(lambda (name / temp)
11.                     (if (setq temp (_GetRecursiveSubfolders (setq name (strcat path "\\" name))))
12.                       (cons name temp)
13.                       (list name)))
14.                  (vl-remove-if '(lambda (name) (wcmatch name "`.,`.`."))
15.                    (vl-directory-files path nil -1)))))

Just take note that if your folders contain Unicode characters this won't list them. If you use unicode characters in your foldernames, then RenderMan's solution of using the Scripting.FileSystemObject is the only one I know of which works well.

Edit: Slightly simplified recursive subfolder list:

Code - Auto/Visual Lisp: [Select]

1. (defun _GetRecursiveSubfolders (path /)
2.   (setq path (vl-string-right-trim "\\/" path))
3.   (apply 'append
4.          (mapcar '(lambda (name / temp)
5.                     (cons name (_GetRecursiveSubfolders (setq name (strcat path "\\" name)))))
6.                  (vl-remove-if '(lambda (name) (wcmatch name "`.,`.`."))
7.                    (vl-directory-files path nil -1)))))

I don't seem to be able to get at a tail-call-recursive method for this though. So if your paths are around 20000 deep expect errors ... though you'd have some strange folder structure to get to that point  :ugly:

[irneb]

And my version using the FileSystemObject:

Code - Auto/Visual Lisp: [Select]

1. (defun _GetSubfolders  (path recurse / fso folders)
2.   (if (not (vl-catch-all-error-p
3.              (setq fso (vl-catch-all-apply 'vlax-get-or-create-object '("Scripting.FileSystemObject")))))
4.     (setq folders (apply 'append
5.                          (mapcar '(lambda (f / p)
6.                                     (cons (setq p (vlax-get f 'Path))
7.                                           (if recurse (_GetSubfolders p recurse))))
8.                                  (cond ((and (not (vl-catch-all-error-p (setq path (vl-catch-all-apply 'vlax-invoke (list fso 'GetFolder path)))))
9.                                              (not (vl-catch-all-error-p (setq folders (vl-catch-all-apply 'vlax-get (list path 'SubFolders))))))
10.                                         (Collection->List folders)))))))
11.   (vl-catch-all-apply 'vlax-release-object (list fso))
12.   folders)

[gile]

Hi,

I don't seem to be able to get at a tail-call-recursive method for this though.

AFAIK, AutoLISP doesn't manage tail-recursion.

[irneb]

Yes, I know - though it's still a good principle to try for. Otherwise all recursive functions would run into stack overflows if the list of calls are long (even if the interpreter/compiler optimizes tail-recursion).

Anyhow, it's a moot point for this scenario. I think the PC might just crash if you have folder paths 20000 levels deep!

One other thing to take note of: The recursive folder listing might take some time if there are 100's (or even 1000's) of folders - never mind their depth. A possible solution is to use dgorsman's depth-limit, see my version of this here.

[Lee Mac]

Perhaps as an iterative version:

Code - Auto/Visual Lisp: [Select]

1. (defun _getsubfolders ( dir / lst out sub )
2.     (setq lst (list dir))
3.     (while lst
4.         (setq sub nil)
5.         (foreach dir lst
6.             (setq sub
7.                 (append sub
8.                     (mapcar (function (lambda ( x ) (strcat dir "\\" x)))
9.                         (vl-remove-if
10.                             (function (lambda ( x ) (member x '("." ".."))))
11.                             (vl-directory-files dir nil -1)
12.                         )
13.                     )
14.                 )
15.             )
16.         )
17.         (setq out (append sub out)
18.               lst sub
19.         )
20.     )
21.     out
22. )

[irneb]

Yes, I was thinking in the same lines. But seeing as the recursive error only happens so far along (http://www.cadtutor.net/forum/showthread.php?62502-Help-Limit-of-recursive&s=f9ecbd9f8180770b9dac40e615ddf486) I don't think it would ever apply in this case.

Anyhow, folder pathing simply lends itself to recursion doesn't it? It's basically a tree structure, which is one of the major uses of recursion. Though as you've shown you don't "need" recursion for such - just some state variables.

[Lee Mac]

Just skinning the cat 

[ElpanovEvgeniy]

 
my variant

[deegeecees]

Oopss !! I confused Directory and dictionary  :ugly:

Look at the vl-directory-files function with -1 flag.

Thats the one, thank you!

I appreciate all the help, and replies. Some interesting concepts.