AfraLisp Blog

The AutoLisp/Visual Lisp/VBA Resource Website

AfraLisp Blog

Home Newsletter Utter Rubbish Coding Tips AutoCAD Tips Contact Downloads WAUN

Visual Lisp - Directories and Files - Page II

Right, are you ready to create your own file list box? OK here we go. First I'll give you a wee peek at what our dialog will look like :

AfraLisp File Dialog

Looks good hey!
To run this function you must pass it two arguments :

  • A string containing a directory path.

  • A list of file types.

Syntax : (fileselect [directory file_ types])

Example : (fileselect "d:/drawings" '("*.dwg" "*.lsp" "*.dvb"))

Return : A list of selected files.

Oh, by the way, you CAN select multiple files.


The first thing we need to do is write a bit of DCL to create our File Dialog. Copy and paste this into Notepad and save it as "AfraFiles.dcl". 

    FILES : dialog {  
  	label="AfraLisp File Dialog";
 
  	: text {
	key="CDIR";
	} 

  	: row { 

    	: list_box {
	key="DIR";  
        label="Select Directory :";  
        width=25;
	fixed_width_font = true;
	} 

    	: list_box {
	key="FIL"; 
	label="Select Files :"; 
        width = 30; 
        tabs = "20 31 40"; 
        multiple_select = true;
	fixed_width_font = true;
	} 

  	} 

  	: row { 

    	: text {
	key="DIRS";
	} 

    	: text {
	key="FILS";
	} 

  	} 

  	: popup_list {
	key="EXT"; 
	label="Select File Type :";
	fixed_width_font = true;
	} 

  	ok_cancel; 

} 

And now the AutoLisp Coding. Save this as AfraFile.lsp :

 
;CODING STARTS HERE
;;Syntax : (fileselect "d:/drawings" '("*.dwg" "*.lsp" "*.dvb"))


(defun FileSelect (Dir Pat)
(setq DH (load_dialog "afrafiles"))
  (if (and DH (new_dialog "FILES" DH))
    (progn
      (setq iExt 0)
      (Refresh_Display)
      (start_list "EXT")
      (mapcar 'add_list Pat)
      (end_list)
      ;
      (action_tile "DIR" "(new_dir $value)")
      (action_tile "EXT" "(new_mask $value)")
      (action_tile "FIL" "(picked $value)")
      ;
      (if (= (start_dialog) 0)
(setq File_List nil)
      )
      (unload_dialog DH)
    )
  )
  File_List
)
;------------------------------------------------
(defun Refresh_Display ()
  (start_list "FIL")
  (end_list)
  (set_tile "CDIR" "Working...")
  (setq FL (VL-Directory-Files
             ;Dir Pat 1)
             Dir (nth iExt Pat) 1)
DR (VL-Directory-Files
     Dir nil -1)
FL (VL-Sort FL 'str_compare)
DR (VL-Sort DR 'str_compare)
)
  (start_list "DIR")
  (mapcar 'add_list DR)
  (end_list)
  (start_list "FIL")
  (if Show_the_details
    (mapcar
      '(lambda (F)
(setq Dt (VL-File-SysTime
    (strcat Dir F))
       F1 (if Dt
    (strcat
      F
      "\t"
      (itoa_f (nth 1 Dt) 2)
      "/"
      (itoa_f (nth 3 Dt) 2)
      "/"
      (itoa_f (nth 0 Dt) 4)
      "\t"
      (itoa_f (nth 4 Dt) 2)
      ":"
      (itoa_f (nth 5 Dt) 2)
      ":"
      (itoa_f (nth 6 Dt) 2)
      )
    (strcat F "\t\t")
  )
       Sz (VL-File-Size (strcat Dir F))
       F1 (strcat
    F1
    "\t"
    (rtos Sz 2 0))
       )
     (add_list F1))
  FL)
    (mapcar 'add_list FL)
  )
  (end_list)
  (set_tile "DIRS"
    (strcat
      "Directories = "
      (itoa (length DR))))
  (set_tile "FILS"
    (strcat
      "Files = "
      (itoa (length FL))))
  (set_tile "CDIR" Dir)
  )

(defun New_Dir (Pth)
  (setq Pth (nth (atoi Pth) DR))
  (cond
    ((= Pth ".")
     nil
     )
    ((= Pth "..") ;;back up a directory
     ;;remove directory name up one
     (setq L (1- (strlen Dir))
   Dir (substr Dir 1 L)
   )
     (while (/= (substr Dir L 1) "/")
       (setq L (1- L)))
     (setq Dir (substr Dir 1 L))
    )
    ('T
     (setq Dir (strcat Dir Pth "/"))
     )
  )
  (Refresh_Display)
)
;------------------------------------------------
;; Call back function to handle new file mask
;; selection by the user.
;;

(defun New_Mask (II)
  (setq iExt (atoi II))
  (Refresh_Display)
)
;
;------------------------------------------------
;; Call back function for saving the selected
;; file list in the variable FILE_LIST.
;;

(defun Picked (val / V)
  (setq val (read (strcat "(" Val ")"))
File_List
(mapcar '(lambda (V)
    (strcat
      Dir
      (nth V FL)))
Val)
)
)
;;-----------------------------------------------
;; Convert integer to padded ASCII string 
;;

(defun Itoa_F (I Digs)
  (setq I (itoa I))
  (while (< (strlen I) Digs)
    (setq I (strcat "0" I)))
  I
  )
;;-----------------------------------------------
(defun Str_Compare (T1 T2)
  (< (strcase T1)
     (strcase T2)))

(princ)
;;-----------------------------------------------
;CODING ENDS HERE

I just like to thank Bill Kramer from whom I "stole" a lot of this coding from.
(Shush, don't say anything as he doesn't know yet!!!)


I can just hear you now. "But Kenny, why do we have to copy and paste the coding? Can't you give us a nice little Zip file to download like you normally do?"
Oh all right then, just click here. Now please stop whining!!!

     

 
The AutoLisp/Visual Lisp/VBA Resource Website

Copyright © 1999-Perpetuity by AfraLisp

All rights reserved.
Information in this document is subject to change without notice.
Site created and maintained by Kenny Ramage

The AutoLisp/Visual Lisp/VBA Resource Website