List of Lisp's

I don't know if anyone else has this problem, but I have lisp routines I have forgotten about. So I wrote this routine to tell me what I have.

Just wanted to share.
Tim

(defun c:GetLispList (/ DirPath LspList FileName FullPath OpndFile LineTxt FuncList
FullList TxtFile temp1 temp2)

(command "_.cmdecho" (getvar "cmdecho"))
(if (setq DirPath (DIRECTORY-DIA))
(progn
(setq LspList (vl-directory-files DirPath "*.lsp"))
(setq LspList (vl-sort LspList '<))
(foreach item LspList
(setq FileName item)
(setq FullPath (strcat DirPath item))
(setq OpndFile (open FullPath "r"))
(while (setq LineTxt (read-line OpndFile))
(if
(and
(setq temp1 (vl-string-search "DEFUN C:" (strcase LineTxt)))
(setq temp2 (vl-string-search "\(" LineTxt))
(> temp1 temp2)
)
(progn
(setq temp1 (substr LineTxt (+ 9 temp1)))
(setq temp2 (vl-string-search "\(" temp1))
(setq FuncList (cons (substr temp1 1 temp2) FuncList))
)
)
)
(close OpndFile)
(setq FuncList (vl-sort FuncList '<))
(setq FullList (cons (list FileName FuncList (GetSubFuncs FullPath)) FullList))
(setq FuncList nil)
)
)
)
(setq TxtFile (strcat DirPath "Lisp-List.txt"))
(setq OpndFile (open TxtFile "w"))
(foreach item (reverse FullList)
(write-line (strcat "--Lisp file name - " (car item)) OpndFile)
(write-line "" OpndFile)
(foreach item2 (cadr item)
(write-line (strcat " Function name - " item2) OpndFile)
)
(write-line "" OpndFile)
(if (caddr item)
(foreach item2 (caddr item)
(write-line (strcat " Sub-Function name - " item2) OpndFile)
)
)
(write-line "" OpndFile)
)
(close OpndFile)
(prompt (strcat "\n Log file location \"" TxtFile"\"."))
(princ)
)

;---------------------------

(defun GetSubFuncs (LispFile / SubFuncList OpndFile temp1 temp2 temp3)

(setq OpndFile (open LispFile "r"))
(while (setq temp1 (read-line OpndFile))
(if
(and
(setq temp2 (vl-string-search "DEFUN" (strcase temp1)))
(setq temp3 (vl-string-search "\(" temp1))
(> temp2 temp3)
(not (vl-string-search "C:" (strcase temp1)))
)
(progn
(setq temp2 (substr temp1 (+ 7 temp2)))
(setq temp1 (vl-string-search "\(" temp2))
(setq SubFuncList (cons (substr temp2 1 temp1) SubFuncList))
)
)
)
(close OpndFile)
(vl-sort SubFuncList '<)
)

;--------------------------------------------------------------

(defun DIRECTORY-DIA ( / sh folder parentfolder folderobject result)
;By Tony Tanzillo
;Modified by Tim Willey
(vl-load-com)
(setq sh
(vla-getInterfaceObject
(vlax-get-acad-object)
"Shell.Application"
)
)

(setq folder
(vlax-invoke-method
sh
'BrowseForFolder
0
""
0
)
)
(vlax-release-object sh)

(if folder
(progn
(setq parentfolder
(vlax-get-property folder 'ParentFolder)
)
(setq FolderObject
(vlax-invoke-method
ParentFolder
'ParseName
(vlax-get-property Folder 'Self)
)
)
(setq result
(vlax-get-property FolderObject 'Path)
)
(mapcar 'vlax-release-object
(list folder parentfolder folderobject)
)
(setq result (strcat result "\\"))
)
)
)

 

Tim

Thanks...works great.
I can sure use this neat tool.

Gary

forgotten about. So I wrote this routine to tell me what I have.

 

It would really be cool to read any subfolders also...

Gary

 

I only have one folder for my lisp routines. I can give you some code that I used in another function to get all the files in sub-folders.

Tim

ps Glad someone else sees it as helpful.

 

Yes, plesase send it.

Thanks again

Gary

used in another function to get all the files in sub-folders.

 

(defun FileList (FileExt / DirPath SubPath DirList SubPath2 CurDate FileName Opened FileExt2 temp1 temp2)

; Used like (FileList "dwg") to search a directory and all
; it's sub-directory for anything with a ".dwg" extension.
; Tim Willey 12/2004


(setq FileExt2 (strcat "*." FileExt))
(setq FileExt (strcase FileExt))
(if (setq DirPath (DIRECTORY-DIA))
(progn
(setq SubPath (vl-directory-files DirPath nil -1))
(setq DirList (cons DirPath DirList))
(while SubPath
(foreach item SubPath
(if
(or
(= "." item)
(= ".." item)
)
(princ)
(progn
(setq temp1 (strcat DirPath item "\\"))
(setq SubPath2 (cons temp1 SubPath2))
)
)
)
(setq SubPath nil)
(foreach item SubPath2
(setq DirList (cons item DirList))
(setq temp1 (vl-directory-files item nil -1))
(if (> (length temp1) 2)
(foreach item2 temp1
(if
(or
(= "." item2)
(= ".." item2)
)
(princ)
(setq SubPath (cons (strcat item item2) SubPath))
)
)
)
)
(setq DirPath "")
(setq SubPath2 nil)
)
)
)
(setq DirList (vl-sort DirList '<))
(setq DirPath (car DirList))
(setq CurDate (rtos (getvar "CDATE") 2 4))
(setq CurDate (strcat (substr CurDate 5 2)"-"(substr CurDate 7 2)"-"(substr CurDate 3 2)))
(setq FileName (strcat DirPath FileExt "-List-On_" CurDate ".txt"))
(if (not (setq Opened (open FileName "w")))
(progn
(setq temp1 (vl-filename-directory FileName))
(while (setq temp2 (vl-string-search ":" temp1))
(setq temp1 (strcat (substr temp1 1 temp2) (substr temp1 (+ 2 temp2))))
)
(setq temp1 (vl-string-translate "\\" "-" temp1))
(setq temp1 (strcat "ForDirectory-[" temp1 "]"))
(setq FileName (strcat "C:\\" FileExt "-List-On_" CurDate temp1 ".txt"))
(setq Opened (open FileName "w"))
)
)
(foreach item DirList
(write-line (strcat "Path - " item) Opened)
(setq temp1 (vl-directory-files item FileExt2 1))
(foreach item2 temp1
(write-line (strcat " File Name - " item2) Opened)
)
(write-line "" Opened)
)
(close Opened)
(prompt (strcat "\n Log file location is \"" FileName "\"."))
(initget "Y N")
(setq temp1 (getkword "\n Open log file [<Y>es No]: "))
(if (or (not temp1) (= temp1 "Y"))
(startapp "notepad.exe" FileName)
)
(princ)
)

Here you go Gary. Enjoy.

Tim

 

Thanks, I will play with it tonight...

Gary

 

It would really be cool to read any subfolders<<<

Here's a routine that will get you a list of all subdirectories of a drive.

Code:

;;04/22/04 Bill Zondlo Program to get list of all directories.
;;Usage - (setq dirlist (AllDirList "g:\\"))
;;
(defun AllDirList (drive / dir_lst dir_nxt)
(vl-load-com)
(setq dir_lst (list drive))
(while dir_lst
(setq dir_nxt (mapcar '(lambda (x)
(vl-remove-if '(lambda (str)(member (strcase str)'("." "..")))
(vl-directory-files x nil -1))) dir_lst)
dir_lst (mapcar '(lambda (a b) (mapcar '(lambda (x)(strcat a x "\\")) b )) dir_lst dir_nxt)
dir_lst (apply 'append dir_lst)
dir_main (append dir_lst dir_main)
)
)                                                   ;end while
(acad_strlsort (append (list drive) dir_main))    ;rem out if not needed.
)

Bill