There may be an easer way to do this but I put together some subroutines I have collected
and created a routine to make a text file list of files of a given type in a directory.
I needed this to create a slide library and to document the DWG files in 10+ folders.
The routine starts in a file open dialog box where you must navigate to the target
directory and select a file of the type you want to make the list from.
The new text file is stored in that directory & the file name starts with the
directory name + type.
Enjoy.
;;; fn2file.lsp by Charles Alan Butler
;;; by Precision Drafting & Design All Rights Reserved.
;;; Contact at ab2draft@TampaBay.rr.com
;;;
;;; Version 1.1 Nov 26,2004
;;;
;;; DESCRIPTION
;;; Create a text file with file names of a given type in a
;;; specific directory. Text file name is the directory name
;;; First line is the path then all files names
;;; Tet file is saved in that directory
;;;
;;;
;;; Limitations
;;; Limited error checking
;;;
;;;
;;; Command Line Usage
;;; Command: fn2file
;;;
;;;
;;; THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED
;;; WARRANTY. ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR
;;; PURPOSE AND OF MERCHANTABILITY ARE HEREBY DISCLAIMED.
;;;
(defun c:fn2file (/ flist path ftype fname tmp)
(and ; get the path & file type by selecting a file in the target folder
(setq path (getfiled "Select a File Type in Folder you want the list from" "" "" 0))
(setq ftype (strcat "*" (caddr (fnsplitl path)))) ; extract file type
(setq path (car (fnsplitl path))) ; extract path
(setq flist (megetfolders path ftype nil)) ; get the files list
(setq tmp (caar flist))
(setq flist (cons tmp (sort-list (cdr(car flist))))) ; sort the files list
;; Create the text file name
(setq fname (strcat path (last (splitdirs path)) "-" (substr ftype 3) "-files-list.txt"))
(mk-file fname flist) ; write the text file
(prompt (strcat "\n -=< Text File Created >=-\n" fname))
)
(princ)
)
(prompt "\nTo create a text file of file names enter fn2file.")
; Jürg Menzi (info@menziengineering.ch)
;This code returns folders recursive or not recursive with or without
;file names:
;
; == 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)
)
)
;; Write data to text file
(defun mk-file (fname datalst)
;; open a file for writing
(if (setq fo (open fname "w"))
(progn
(foreach itm datalst (write-line itm fo))
(close fo) ; close the open file handle
T
)
(alert "\nFile was not created.\n")
)
)
;;sort list
(defun sort-list (RawList)
(mapcar '(lambda (x) (nth x RawList))(vl-sort-i RawList '<))
)
;; by MP
; (splitdirs "c:\\123\\456\\789") returns ("c:" "123" "456" "789")
(defun splitdirs (path / r w i c)
(setq w "" i (1+ (strlen path)))
(repeat (strlen path)
(if (member (setq c (substr path (setq i (1- i)) 1)) '( "\\" "/"))
(if (/= w "") (setq r (cons w r) w ""))
(setq w (strcat c w))
)
)
(if (/= w "") (cons w r) r)
;; remove file name added by CAB
(if (wcmatch path "*`.*") ; has file name ?
(reverse (cdr (reverse r))) ; remove it
r
)
)
