TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: whdjr on December 22, 2004, 10:52:45 AM
-
I was trying to write a tool that would search all subdirectories (below the folder I selected) and return a list of dwgs with the path intact. This is becoming a lengthy process and I didn't know if I was missing something or if someone might know of an easier way. Part of my tool relies on an expresstool command (which I don't particularly like) and searching for files in subfolders seems to be difficult if you are unsure how many subfolders there are.
Any thoughts or suggestions would be helpful.
Thanks,
-
you can do this very easily with the code for the superfind program.
it uses VBA.
do you have the acadx module by Tony Tanzillo?
-
No. I don't have it. I am really close to getting it. I have written recursively, but I'm not sure how I can get it to save the folder names though. It just gives me a bunch of nil lists.
Here is my code so far:
(defun c:test ()
(find_dwgs (acet-ui-pickdir))
)
(defun find_dwgs (path / folders files)
(setq folders (get_folders path))
)
(defun get_folders (folder / f)
(if (setq f (cddr (vl-directory-files folder nil -1)))
(mapcar '(lambda (x)(get_folders (strcat folder "\\" x))) f)
)
)
The code looks a little bare, but I stripped out a bunch of other options and stuff to go with it just to make it a bit more readable and understandable.
-
Perhaps this will give you some ideas.
;;; fn2file.lsp by Charles Alan Butler
;;; by Precision Drafting & Design All Rights Reserved.
;;; Contact at ab2draft@TampaBay.rr.com
;;;
;;; Version 1.0 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
;;; The 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 myfile path ftype fname)
(and
;;(setq path (ale_browseforfolder "Select directory to get files:"))
;;(setq path (strcat path "\\"))
(setq path (getfiled "Select a File Type in Folder you want the list from" "" "" 4))
(setq ftype (strcat "*" (caddr (fnsplitl path))))
(setq path (car (fnsplitl path)))
(setq flist (megetfolders path ftype nil)); change nil to T to get sub folders
(setq fname (strcat path (last (splitdirs path)) "-" (substr ftype 3) "-files-list.txt"))
(mk-file fname (car flist))
)
(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
(setq fo (open fname "w"))
(foreach itm datalst (write-line itm fo))
(close fo) ; close the open file handle
)
; Example: (ALE_BrowseForFolder "Select drawings folder")
; Original BrowseForFolder by Tony Tanzillo
(defun ALE_BrowseForFolder (PrmStr / ShlObj Folder FldObj OutVal)
(vl-load-com)
(setq
ShlObj (vla-getInterfaceObject
(vlax-get-acad-object)
"Shell.Application")
Folder (vlax-invoke-method ShlObj 'BrowseForFolder 0 PrmStr 0)
)
(vlax-release-object ShlObj)
(if Folder
(progn
(setq FldObj (vlax-get-property Folder 'Self)
OutVal (vlax-get-property FldObj 'Path)
)
(vlax-release-object Folder)
(vlax-release-object FldObj)
OutVal
)
)
)
;; 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
)
)
-
Hey Swampers,
Find a file in subdirectories using recursion.
the syntax is
(findfilex "c:/acad/" "312vg.dwg")
It will return a list of the files
Peter Jamtgaard
(defun FINDFILEX (PATH FNAME / DIRLST2)
(if (findfile (strcat PATH FNAME))
(setq DIRLST2 (list (findfile (strcat PATH FNAME))))
)
(search PATH FNAME)
)
(defun SEARCH (PATH FNAME / DIRLST PATH2)
(vl-load-com)
(setq DIRLST (vl-directory-files PATH nil -1))
(if DIRLST
(foreach N DIRLST
(if (and (/= N ".")(/= N "..")(/= N nil))
(progn
(setq PATH2 (strcat PATH N "/"))
(if (findfile (strcat PATH2 FNAME))
(setq DIRLST2 (cons (findfile (strcat PATH2 FNAME)) DIRLST2))
)
(search PATH2 FNAME)
)
)
)
)
(reverse DIRLST2)
)
-
Thanks CAB.
The recursive section by Jürg Menzi had the missing link I needed.
-
Yet another, written long ago (wrapped in a primitive interface command)
(defun C:SEARCHFOR (/ foundfiles folder fn)
(defun filesearch (fld filename / fld fn found flst lst)
(cond ((setq flst (vl-remove ".." (vl-remove "." (vl-directory-files fld))))
(setq lst (mapcar (function (lambda (n)
(if (= (substr fld (strlen fld) 1) "\\")
(strcat fld n)(strcat fld "\\" n))))
flst)
)
(foreach fd lst
(cond ((vl-file-directory-p fd)
(filesearch fd filename))
(T
(cond ((wcmatch fd filename)
(setq found fd
foundfiles (cons found foundfiles)
)
(princ found)
(terpri)))))
)
)
)
)
(setq folder (getstring "\nStart in folder: ")
fn (getstring "\nFile to search for: ")
)
(if (= folder "")(setq folder (getenv "systemDrive")))
(cond ((and folder (/= fn ""))
(filesearch folder fn))
)
(princ (strcat "\n" (itoa (length foundfiles)) " files found"))
(princ)
)
-
Yet another, written long ago (wrapped in a primitive interface command)
there it is!! I was waiting for you to dig that out. :D
I remember seeing that code but couldn't remember where or when.
thanks guys, that is some very nice code.
-
there it is!! I was waiting for you to dig that out.
You could just have asked :D
-
"Ask and you shall receive"