Author Topic: Files List to Text File Routine  (Read 1870 times)

0 Members and 1 Guest are viewing this topic.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10365
Files List to Text File Routine
« on: November 26, 2004, 04:30:02 PM »
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. :)

Code: [Select]
;;;  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
  )
)
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.