TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: whdjr on June 08, 2005, 09:30:19 AM
-
I have this code that returns all the directories and subdirectories of the supplied path.
;;;usage (list_folders "d:\test" T)
;;;path --> is the starting path
;;;sub --> is either T or nil for recording subdirectories
(defun list_folders (path sub)
(defun get_folders (folder / f)
(mapcar '(lambda (x)
(setq f (strcat folder "\\" x))
(if sub
(cons f (apply 'append (get_folders f)))
)
)
(cddr (vl-directory-files folder nil -1))
)
)
(cons path (apply 'append (get_folders path)))
)
What I would like is to see if someone could help me modify it so that it will only concantenate the folder names after the original path.
Example:
This is my folder structure:
(http://www.theswamp.org/screens/whdjr/ScreenShot039.jpg)
If I set my original path as 'd:\test' I want it to return ('test a' 'test a\test a1' 'test a\test a2' 'test b' 'test b\test b1' 'test b\test b2') without the orinigal path included.
Does that make any sense?
-
First gather (in a list) all paths as fully qualified paths, e.g. ("d:\\test\\test a" "d:\\test\\test a\\ test a1" ...).
Then, using mapcar, apply a function to the list that strips of the first 'n' characters of every item, said length corresponding to the original path plus 1.
/idea
-
Yeah that's the easy way. :D
What I want to do is compare a list of folder structures that will have a different starting path, so I didn't want to have to add the path and then remove the path. If that's the easiest way then I guess I could do that, I just thought the other way would be quicker. :?
-
Hi Will
Maybe this one can help:;
; == Function MeGetFolders
; Scans from current folder (recursive) for folders (and files).
; Arguments [Type]:
; Fol = Root folder [STR]
; Pat = File name pattern
; - Not False: eg. *.*, *.dwg [STR]
; - False: Folders only [BOOLEAN]
; Rec = Recursive flag [BOOLEAN]
; - True: scan folders recursive
; - False: scan first folder level
; Return [Type]:
; > If pattern argument False:
; '("Pth1" "Pth2"...) [LIST]
; > If pattern argument not False:
; '(("Pth1" '("Fil1" "Fil2"...)) ("Pth2" '(...))...) [LIST]
; Notes:
; - If no files found in a folder, the file list returns a '("").
; - Deep folder structure slow down the function.
;
(defun MeGetFolders (Fol Pat Rec / FolLst TmpFol)
(setq TmpFol (if (wcmatch Fol "*\\") (substr Fol 1 (1- (strlen Fol))) Fol)
FolLst (cons TmpFol (apply 'append (MeGetFoldersRec TmpFol Rec)))
)
(if Pat
(mapcar
'(lambda (l)
(cons l (cond ((vl-directory-files l Pat 1)) ('(""))))
) FolLst
)
FolLst
)
)
;
; == Function MeGetFoldersRec
; Recursive function for MeGetFolders.
; Arguments [Type]:
; Fol = Folder [STR]
; Rec = Recursive flag [BOOLEAN]
; - True: scan folders recursive
; - False: scan first folder level
; Return [Type]:
; > Folder list '((Pth1) (Pth2)) [LIST]
; Notes:
; Return value contain nil atoms.
;
(defun MeGetFoldersRec (Fol Rec / TmpFol)
(mapcar
'(lambda (l)
(if (not (wcmatch l "`.*"))
(cons
(setq TmpFol (strcat Fol "\\" l))
(if Rec (apply 'append (MeGetFoldersRec TmpFol Rec)))
)
)
) (vl-directory-files Fol nil -1)
)
)
Cheers
-
This is what I came up with following MP's advice even though I think it is too much processing. If anyone has any more thoughts please share. For now I will use this and continue.
(defun get_folders (path) (cddr (vl-directory-files path nil -1)))
(defun str_cat (path name) (strcat path "\\" name))
(defun get_subs (folder / f)
(mapcar '(lambda (x)
(setq f (str_cat folder x))
(cons f (apply 'append (get_subs f)))
)
(get_folders folder)
)
)
(setq tfolder "C:\\ADT 2005 CD Image"); <--Insert your folder name here
(mapcar '(lambda (x) (substr x (1+ (strlen tfolder))))
(apply 'append (get_subs tfolder))
)
Thanks MP.
-
My pleasure Will.
First thing I'd do once I proved an algorythm works is attempt to remove any unnecessary processing, esp. from iterative coding, for example --
(setq pointer (1+ (strlen tfolder)))
(mapcar
'(lambda (x) (substr x pointer))
(apply 'append (get_subs tfolder))
)
:)
Also, consider that your core functions should perform the bulk of this work for you, that is, the mapcar bit above should be transparent to the caller.
/IMO
:)
-
:(
That was a last minute add after I realized 'vl-string-left-trim removed too much of the string. I didn't test it fully before posting. :?
I know, I know, that is a bad practice. I won't let it happen again Mr.Puckett. :)
-
Wasn't trying to sound finger wavin' Will, just trying to help in whatever small ways I can.
:)
-
Yeah I know, I was just havin a little laugh. :lol:
-
Jürg, Hey thats perty cool! I like that.
-
Jürg, Hey thats perty cool! I like that.
Thx for the flowers :)