;*  AutoLISP Files for Maximizing AutoCAD Volume II - IL DISK Version 11.00
;*   (c) 1987, 1988, 1989, 1991 New Riders Publishing. All Rights Reserved.
;*       Developed by Rustin Gesner, Patrick Haessly and Joseph Smith

(prompt "\nLoading Lisputil.lsp")



;* DXF takes an integer dxf code and an entity data list.
;* It returns the data element of the association pair.

(defun dxf(code elist)
  (cdr (assoc code elist))   ;finds the association pair, strips 1st element
);defun
;*

;* ANGTOC is an angle formatting function that takes an angle
;* argument in radians and returns it with 6 decimal places
;* in a form universally acceptable to AutoCAD command input.

(defun angtoc (ang)
  (setq ang
    (rtos (atof (angtos ang 0 8)) 2 6)
  )
  (strcat "<<" ang)
);defun



;* UDIST User interface distance function
;* BIT (0 for none) and KWD key word ("" for none) are same as for INITGET.
;* MSG is the prompt string, to which a default real is added as <DEF> (nil
;* for none), and a : is added. BPT is base point (nil for none).

(defun udist (bit kwd msg def bpt / inp)
  (if def                                              ;test for a default
    (setq msg (strcat "\n" msg "<" (rtos def) ">: ")   ;string'em  with default
          bit (* 2 (fix (/ bit 2))) ;a default and no null bit code conflict so
    );setq                          ;this reduces bit by 1 if odd, to allow null
    (if (= " " (substr msg (strlen msg) 1))            ;no def, if last char is space
      (setq msg (strcat "\n" (substr msg 1 (1- (strlen msg))) ": ")) ;then strip space
      (setq msg (strcat "\n" msg ": "))                ;else msg OK
  ) );if,if
  (initget bit kwd)
  (setq inp
    (if bpt                  ;check for a base point
      (getdist msg bpt)      ;and use it in the GET commands
      (getdist msg)
  ) );setq&if
  (if inp inp def)           ;compare the results, return appropriate value
);defun



;* UKWORD User key word. DEF, if any, must match one of the KWD strings
;* BIT (1 for no null, 0 for none) and KWD key word ("" for none) are same as
;* for INITGET. MSG is the prompt string, to which a default string is added as
;* <DEF> (nil or "" for none), and a : is added.

(defun ukword (bit kwd msg def / inp)
  (if (and def (/= def ""))                     ;test for both nil and null string
    (setq msg (strcat "\n" msg "<" def ">: ")   ;string'em  with default
          bit (* 2 (fix (/ bit 2))) ;a default and no null bit code conflict so
    );setq                          ;this reduces bit by 1 if odd, to allow null
    (if (= " " (substr msg (strlen msg) 1))     ;no def, if last char is space
      (setq msg (strcat "\n" (substr msg 1 (1- (strlen msg))) ": ")) ;then strip space
      (setq msg (strcat "\n" msg ": "))         ;else msg OK
  ) );if,if
  (initget bit kwd)                             ;initialize the key words
  (setq inp (getkword msg))                     ;and use the GET command
  (if inp inp def)               ;compare the results, return appropriate value
);defun



;* USTR User interface string
;* If BIT=1 no null "" input allowed, 0 for none, BIT ignored if DEF present.
;* MSG is the prompt string, to which a default string is added as <DEF> (nil
;* or "" for none), and a : is added. If SPFLAG T, spaces are allowed in string.

(defun ustr (bit msg def spflag / inp nval)
  (if (and def (/= def ""))                    ;test for both nil and null string
    (setq msg (strcat "\n" msg "<" def ">: ")  ;then include the default string
          inp (getstring msg spflag)           ;get input, ignore no null bit
          inp (if (= inp "") def inp)          ;if null input, return default
    );setq
    (progn
      (if (= " " (substr msg (strlen msg) 1))            ;no def, if last char is space
        (setq msg (strcat "\n" (substr msg 1 (1- (strlen msg))) ": ")) ;then strip space
        (setq msg (strcat "\n" msg ": "))                ;else msg OK
      );if
      (if (= bit 1)                            ;if no null bit set to 1
          (while (= "" (setq inp (getstring msg spflag))) ;then get input, no ""
            (prompt "\nInvalid string.")
          )
          (setq inp (getstring msg spflag))    ;else get input, "" ok
    ) );progn&if
  );if
  inp
);defun



;* UINT User interface integer function
;* BIT (0 for none) and KWD key word ("" for none) are same as for INITGET.
;* MSG is the prompt string, to which a default integer is added as <DEF> (nil
;* for none), and a : is added.

(defun uint (bit kwd msg def / inp)
  (if def                                                 ;test for a default
    (setq msg (strcat "\n" msg "<" (itoa def) ">: ")      ;string'em with default
         bit (* 2 (fix (/ bit 2)))  ;a default and no null bit code conflict so
    )                               ;this reduces bit by 1 if odd, to allow null
    (if (= " " (substr msg (strlen msg) 1))            ;no def, if last char is space
      (setq msg (strcat "\n" (substr msg 1 (1- (strlen msg))) ": ")) ;then strip space
      (setq msg (strcat "\n" msg ": "))                ;else msg OK
  ) );if,if
  (initget bit kwd)
  (setq inp (getint msg))       ;use the GETINT function
  (if inp inp def)              ;compare the results, return appropriate value
);defun



;* UREAL User interface real function
;* BIT (0 for none) and KWD key word ("" for none) are same as for INITGET.
;* MSG is the prompt string, to which a default real is added as <DEF> (nil
;* for none), and a : is added.

(defun ureal (bit kwd msg def / inp)
  (if def                                                  ;test for a default
    (setq msg (strcat "\n" msg "<" (rtos def 2) ">: ")     ;string'em with default
          bit (* 2 (fix (/ bit 2)))  ;a default & no null bit code conflict so
    )                                ;this reduces bit by 1 if odd, to allow null
    (if (= " " (substr msg (strlen msg) 1))            ;no def, if last char is space
      (setq msg (strcat "\n" (substr msg 1 (1- (strlen msg))) ": ")) ;then strip space
      (setq msg (strcat "\n" msg ": "))                ;else msg OK
  ) );if,if
  (initget bit kwd)
  (setq inp (getreal msg))           ;the GETREAL function
  (if inp inp def)                   ;compare the results, return appropriate value
);defun



;* UPOINT User interface point function
;* BIT (1 for no null, 0 for none) and KWD key word ("" for none) are same as
;* for INITGET. MSG is the prompt string, to which a default point variable is
;* added as <DEF> (nil for none), and a : is added. BPT is base point (nil for none).

(defun upoint (bit kwd msg def bpt / inp)
  (if def                                              ;check for a default
    (setq pts (strcat
                (rtos (car def)) "," (rtos (cadr def)) ;formats X,Y 2D pt as string
                (if                 ;formats 3D ,Z if supplied and FLATLAND off
                  (and (caddr def) (= 0 (getvar "FLATLAND")))
                  (strcat "," (rtos (caddr def)))
                  ""
              ) );if&strcat
          msg (strcat "\n" msg "<" pts ">: ")          ;string them with default
          bit (* 2 (fix (/ bit 2)))   ;a default and no null bit code conflict so
    )                                 ;this reduces bit by 1 if odd, to allow null
    (if (= " " (substr msg (strlen msg) 1))            ;no def, if last char is space
      (setq msg (strcat "\n" (substr msg 1 (1- (strlen msg))) ": ")) ;then strip space
      (setq msg (strcat "\n" msg ": "))                ;else msg OK
  ) );if,if
  (initget bit kwd)
  (setq inp
    (if bpt                           ;check for base point
      (getpoint msg bpt)              ;and use it
      (getpoint msg)                  ;but not if nil
  ) );setq&if
  (if inp inp def)                    ;evaluate results and return proper value
);defun



;* UANGLE User interface angle function
;* BIT (1 for no null, 0 for none) and KWD key word ("" for none) are same as
;* for INITGET. MSG is the prompt string, to which a default real in rads is
;* added as <DEF> (nil for none), and a : is added. BPT is base point (nil for none).

(defun uangle (bit kwd msg def bpt / inp)
  (if def
    (setq msg (strcat "\n" msg "<" (angtos def) ">: ")
          bit (* 2 (fix (/ bit 2)))
    )
    (if (= " " (substr msg (strlen msg) 1))            ;no def, if last char is space
      (setq msg (strcat "\n" (substr msg 1 (1- (strlen msg))) ": ")) ;then strip space
      (setq msg (strcat "\n" msg ": "))                ;else msg OK
  ) );if,if
  (initget bit kwd)
  (setq inp
    (if bpt
      (getangle msg bpt)
      (getangle msg)
  ) )
  (if inp inp def)
);defun



;*; DO NOT LSPSTRIP - MERGEF contains ;'s
;*  AutoLISP Files for Maximizing AutoCAD Volume II - IL DISK Version 11.00
;*   (c) 1987, 1988, 1989, 1991 New Riders Publishing. All Rights Reserved.
;*       Developed by Rustin Gesner, Patrick Haessly and Joseph Smith

;* FILELIB.LSP contains several file handling utility routines

;* CPATH returns current DOS, OS/2 or Unix path: "d:\\path\\...\\" or "/path/.../".
;* WARNING: If DOS or OS/2 APPEND is used results may be FALSE UNPREDICTABLY.
;* If SH (shell) fails with insufficient memory, increase its size in ACAD.PGP.

(defun cpath ( / path fp slash)
                            ;creates 0 byte file, overwrite if existing...
  (close (open "$" "w"))    ;...allows READ-LINE to test SHell's success
  (command "SH"             ;redirect current dir to temp file $
    (cond
      ( (getenv "COMSPEC") (setq slash "\\") "CD   >  $")          ;if DOS or OS/2
      ( (getenv "USER")    (setq slash "/" ) "dirs >! $")          ;Unix
      (T(prompt "\nUNKNOWN OPERATING SYSTEM for CPATH function. "))
  ) );command&cond
  (setq fp (open "$" "r"))
  (if (setq path (read-line fp))                ;nil only if SH failed
    (if (/= slash (substr path (strlen path)))  ;if path doesn't have trailing slash
      (setq path (strcat path slash))           ;adds trailing slash to path
    )
    (progn (prompt "\nSHell FAILED!") (setq path "")) ;sets path to "" if SH failed
  )
  (close fp)
  path                       ;returns path, which is "" only if SHell failed
);defun CPATH



;* RPATH Resets the PATH to the "current AutoCAD directory" if changed by user.
;* For DOS or OS/2 only. Requires CPATH function.

(defun rpath ( / path)
  (if (equal                               ;if ACAD current matches true current
        (cpath)
        (setq path (findfile "nul")                         ;gets "PATH/NUL"
              path (substr path 1 (- (strlen path) 3))      ;strips last 3 char
      ) )
      nil                                                               ;then nil
      (command "SH" (strcat "CD " (substr path 1 (- (strlen path) 1)))) ;else CD
  );if
);defun

;* PSLASH PathSLASH converts "\\"s or "/"s in path strings to whichever is
;* needed by operating system (Unix or DOS and OS/2), and forces trailing "\\" or "/".
(defun pslash (path / slash inc wpath char)
  (setq inc 1  wpath ""                                ;initialize variables
        slash (if (getenv "COMSPEC") "\\"  "/")        ;set for DOS or OS/2, or Unix
  )
  (while (/= "" (setq char (substr path inc 1)))       ;test each char
    (setq wpath                                        ;append proper char back
      (strcat wpath (if (member char '("\\" "/")) slash char))
      inc (1+ inc)                                     ;increment counter
  ) );while&setq
  (if                                                  ;if last char isn't slash
    (and (/= wpath "") (/= (substr wpath (strlen wpath) 1) slash))
    (setq wpath (strcat wpath slash))                  ;make it a slash
  );if
  wpath
);defun PSLASH



;* FFNAME formats a filename as "filename.ext" given input FNAME with or
;* without extension, and EXT as "EXT". Using "" as EXT strips extensions.
(defun ffname (fname ext / inc lngth pos)
  (setq inc -1  lngth (strlen fname))    					 ;initialize, lngth is filename length
  (while
    (not                                  					;loops until OR is non-NIL
      (or                                 					;eval 2nd AND only if 1st is NIL
        (and                             					 ;setq FNAME only if "." = non-NIL
          (/= lngth (setq inc (1+ inc)))
          (= "." (substr fname (- lngth inc) 1))      				;find "."
          (setq                           					;strip last char and append EXT
            fname (strcat (substr fname 1 (- lngth inc)) ext)
          )
        )
        (and                                        					;setq FNAME only if...
          (or (= inc 3) (= inc lngth) (<= lngth 2))				 ;...if "." not found in last 3 char
          (setq fname (strcat fname "." ext))      				 ;then append EXT to whole fname
  ) ) ) )
  fname
);defun



;* VFFILE verifies a file's existence. It returns fspec or NIL.
;* WARNING: DOS or OS/2 APPEND may cause FALSE UNPREDICTABLE results.
;* May be called w/ fname specific path "\\path\\filename.ext", or just
;* "filename.ext", which searches ACAD library path or prompts for path.
;* Uses PSLASH to return "/"s or "\\"s for Unix or DOS and OS/2.

(defun vffile (fspec / fname fp path char prmpt)
  (setq inc -1  lngth (strlen fspec)  fname "") ;initialize
  (while (and (/= lngth (1+ inc)) (not path))   ;parse FSPEC into PATH and FNAME
       (if (member                              ;if char is a slash
             (setq char                         ;get current char, back to front
                   (substr fspec (- lngth (setq inc (1+ inc))) 1)
             )
             '("/" "\\")
           );member
           (setq path (substr fspec 1 (- lngth inc)))   ;then set path to remainder
           (setq fname (strcat char fname))             ;else
  )    )
  (if path nil (setq path ""))                          ;if no path, set "" null
  (while                                  ;while file can't be opened, reprompt
    (and
      (/= "Q" path)                                     ;until Quit
      (not (setq fspec (findfile (strcat (pslash path) fname)))) ;or found
    )
    (setq prmpt                                         ;build prompt
      (strcat "\n\nFile " fname " not found in "
        (if (= "" path) "current directory," path)      ;current dir if path=""
        "\nEnter path to search, or Q to quit: "
      );strcat
      path (getstring prmpt) ; was path (strcase (getstring prmpt))
  ) );while & setq
  (if (= "Q" path)                                      ;returns nil or fspec
      (progn (prompt "File not found. ") nil)           ;nil
      (substr (pslash fspec) 1 (strlen fspec))          ;fspec
  )
);defun vffile



;* VFPATH is for compatibility with original CA DISK programs which call it
;* with a filename argument. It calls a substitute function, VPATH.
;* The FN argument is not used in VPATH.

(defun vfpath (fn) (vpath))



;* VPATH prompts for and verifies a PATH. On non-DOS systems, the filename "$."
;* will be left behind in the successful directory, as a 0 byte file.
;* Adding (command "FILES" "3" (strcat path "$") "" "") will delete it.
;* It calls CPATH to present a default path.

(defun vpath ( / char path fp def)
  (setq def (cpath))                                     ;default current path
  (while (not path)                                      ;loops until valid path
    (setq path                                           ;get path name
          (getstring (strcat "\nEnter path name <" def ">: "))
    )
    (if (/= "" path)                                     ;user wants current path
      (if (getenv "COMSPEC")                             ;then, if DOS or OS/2
        (or (findfile (strcat (pslash path) "nul"))
            (setq path (prompt "\nInvalid path, try again."))   ;path not found
        )
        (progn                                           ;not DOS or OS/2
          (setq path (pslash path))                      ;check for valid path syntax
          (if (setq fp (open (strcat path "$") "a"))     ;test user's path entry
            (close fp)                                   ;path found, close temp file
            (setq path (prompt "\nInvalid path, try again.")) ;path could not be accessed
          );if
        );progn
      );if-getenv
      (setq path def)                                    ;else set to CPATH
    );if/=
  );while
  (pslash path)                                          ;return the path
);defun VPATH



;* BACKUP copies file fspec to its path\name.BAK, using
;* the FFNAME function to format the filename.

(defun backup (fspec)
  (command "FILES" "5" fspec   ;copy filespec.EXT to
    (ffname fspec "BAK")       ;filespec w/ EXT stripped & repl w/ BAK
    "" "" nil                  ;nil cancels error if file didn't exist.
  );command
);defun

;* MERGEF appends file2 to file1, strips file1's ^Z if present, deletes file2
;* If SH (shell) fails w/ insufficient memory, increase size in ACAD.PGP
;* It uses the VFFILE function to verify the filenames' existence. Returns T.

(defun mergef (file1 file2)
  (setq file1 (vffile file1)  file2 (vffile file2))      ;verifies files
  (cond
    ( (getenv "COMSPEC")                               ;if DOS or OS/2
      (command "SH" (strcat "COPY " file1 " + "  file2  " "  file1) nil) ;copy
      (command "SH" (strcat "DEL " file2) nil)         ;delete 2nd file
    )
    ( (getenv "USER")                                  ;if Unix
      (command "SH" (strcat "cat " file1 file2 " >! $" ;use cat command
                      " ; mv $ " file1 " ; rm " file2  ;delete 2nd file
      ) nil         );command&strcat                   ;nil cancels if SH fails
    )
    (T(prompt "\nUNKNOWN OPERATING SYSTEM for MERGEF function. "))
  );cond
  T                                     ;returns T
);defun

;* end of FILELIB.LSP



;*  AutoLISP Files for Maximizing AutoCAD Volume II - IL DISK Version 11.00
;*   (c) 1987, 1988, 1989, 1991 New Riders Publishing. All Rights Reserved.
;*       Developed by Rustin Gesner, Patrick Haessly and Joseph Smith

;;;;;;;(if (not (and ukword ustr))                             ;test subroutines
;;;;;;;  (prompt "\nRequires UKWORD and USTR functions. Load aborted. ")
;;;;;;;  (progn                                                ;else load OK

;* BATCHSCR.LSP contains 4 Script building functions. FILELIB.LSP is required.

;* GETFIL builds the listing of specified files used by the batch builder.
;* GETSCR gets the script commands from the user and returns them in a list.
;* BATSCR builds a script from a GETFIL directory and a script command listing.
;* C:MSCRIPT is a easy user interface for BATSCR.

;;;;;;;;;;;(if pslash nil (load "filelib"))      ;ensure needed files are loaded


;* GETFIL returns a listing of files matching the path and file spec provided
;* by its arguments. Wildcards are optional for FSPEC filename part but not
;* allowed for the extension (the FSPEC "CA*.DWG" is OK, but *.* is illegal).
;* PATH format "/path/" or "\\path\\" -- use / or \\ as req'd for DOS, OS/2 or UNIX.
;* Trailing \\ or / req'd, (& ..\\ dots illegal). Nil or "" means current dir.
;* It may fail with insufficient string or node space on large file listings.
;* If FNAME is supplied the list is written to that file, and FNAME is returned.
;* If FNAME is nil, a list is returned.

(defun getfil (fspec path fname / flag fp) ;files fp)
  (if fname (setq flag T) (setq fname "DIR.$"))
  (if (setq path (pslash path))       ;test nil (current) path, convert slashes
     (setq fspec (strcat path fspec))                ;string together path/file
  );if
  (close (open fname "w"))                           ;ensure empty file
  (command "SH"                                      ;make filename file
    (cond
      ( (getenv "COMSPEC")                           ;check if DOS or OS/2
        (setq funct '(list (substr fspec 1 (1- (strlen fspec)))))
         (strcat "dir /b " fspec " >> " fname)							; added
;        (strcat "for %f in (" fspec ") do echo %f >> " fname)						; commented
      )
      ( (getenv "USER")                              ;if UNIX						; for %f in *.dwg do echo %f >> test
        (setq funct '(list fspec))									; dir /b *.dwg >> test
        (strcat "ls -1 " fspec " >> " fname)
      )
      (T(prompt "\nUNKNOWN OPERATING SYSTEM for GETFIL function. ")
        (setq flag T fname nil)                      ;exit with error
      )
  ) )
  (if flag fname                                     ;if FNAME, return it and quit
    (progn                                           ;else
      (setq fp (open fname "r"))                     ;open temp file to read filenames
      (if (setq fspec (read-line fp))                ;if there are files in dir
        (progn
          (setq files nil)
          (prompt "\nMaking file listing.")
          (while (and fspec (/= "" fspec))           ;loop for each file name
            (prompt ".")
            (setq files (append files (strcase (eval funct)  t  ))) ;put file name on list			:added strcase t
            (setq fspec (read-line fp))              ;get next filename
          );while
          (close fp)                                 ;close temp dir file
          (command "FILES" "3" fname "" "")          ;delete temp dir file
        );progn
        (prompt (strcat "\nNo " files " found\n"))   ;no files were found
      );if
      files
  ) );if&progn
);defun GETFIL


;* GETSCR assists the user in building a list of commands for the script.
;* It prompts for command input and returns a list in the form:
;*   ("string1" "str2" FNAME "srt3" "str4" ...)  where each string becomes
;* 1 script line, & FNAME is a symbol to be replaced by each file name in sequence.

(defun getscr ( / script input item)
  (setq script '()                                      					;initialize script list
        input T                                         					;set a flag for input control
  );setq
  (while input                                          					;get script input
    (setq item (ustr 0 "Enter commands, FNAME or . to exit" nil T))
    (if (= item ".")                                    					;exit code
      (setq input nil)                                  					;set flag to nil
      (if (= item "FNAME")    			 ;was (strcase item) "FNAME")	;test for file name
        (setq script (append script (strcase (list 'FNAME) t  )))     			;append atom to list   ,adeed strcase t
        (setq script (append script (list item)))      					 ;otherwise, append command string
      );if
    );if
  );while
  script
);defun GETSCR



;* BATSCR processes a GETFIL list & script command list into a script file named
;* BATCH.SCR, which can be executed in the normal manner for scripts.
;* Its SCRIPT arg is the command list, if nil it calls GETSCR.
;* Its file/path args are same as GETFIL's. STOP is the script termination char.
;* Each string becomes 1 script line. If STOP is nil, BATSCR prompts for it.
;* It uses the FILELIB.LSP FFNAME function to strip file extensions.

(defun batscr (fspec path script stop / files fp bfp item)
  (setq files (getfil fspec path nil))
  (if files
    (progn
      (if (not script) (setq script (getscr)))             					;if no script, call subr to get it
      (setq bfp (open "BATCH.SCR" "w"))                    				;open output script file
      (prompt "\nCreating script file.")
      (foreach name files                                 					;process each file name
        (prompt ".")
        (setq name (ffname name "")
                FNAME (strcase (substr name 1 (1- (strlen name))) t)     				;strips .EXT & assigns
        )                                                  					;value to FNAME atom
        (foreach item script                               					;process each script list
          (write-line (strcase (eval item) t) bfp)                     					;eval & output script commands
        );foreach
      );foreach
      (if (not stop)
        (progn
          (prompt "\nR=rerun script, 0=exit to OS, S=Stop, D=delete files")
          (setq stop (ukword 1 "0 Rscript Stop" "Script terminator " "R"))    ; D" "Script terminator " "R"))
;           (if (= stop "D") (setq stop "shell del *.dwg"))
        );progn
      );if
      (write-line stop bfp)                                 ;write script terminator
      (close bfp)                                           ;close script file
    );progn
  );if
  (if bfp T nil)                                            ;return T if script file was opened
);defun BATSCR
;*


;* C:MSCRIPT is an easy user interface command for the above BATSCR.
(defun C:MSCRIPT ( / script path fspec)
  (setq path (ustr 0 "Path name (or ENTER for none)" nil nil)  ;get path name
        fspec (ustr 0 "Enter files to list " "*.DWG" nil)        ;get file spec
  );setq
  (if (not path) (setq path ""))
  (batscr fspec path nil nil)             ;call batscr, no script or terminator
  (princ)
);defun
;*end of BATCHSCR.LSP



;;;;;;;));test subroutines

;;;;;;;(if (not dxf)                                           ;test subroutines
;;;;;;;  (prompt "\nRequires DXF function. Load aborted. ")
;;;;;;;  (progn                                                ;else load OK

;* TBLIST consists of three functions to extract all symbol names for
;* any of the tables or all table data for any symbol. Requires DXF subroutine.

;* TNLIST returns a list of all symbol names found in the specified table.

(defun tnlist (tbname / tdata tblist)
  (while (setq tdata (tblnext tbname (not tdata)))  ;(not tdata) acts as rewind flag in first loop
    (setq tblist (append tblist (list (dxf 2 tdata))))
  )
)

;* TDLIST returns a list of all table data lists for the specified table.
;* For the block table, these are the block head entries.

(defun tdlist (tbname / tdata tblist)
  (while (setq tdata (tblnext tbname (not tdata)))  ;(not tdata) acts as rewind flag in first loop
    (setq tblist (append tblist (list tdata)))
  )
)

;* BLIST returns a list of the block head and subentity data lists for the
;* specified block name.

(defun blist (blname / tblist tdata ename)
  (setq tblist (list (setq tdata (tblsearch "block" blname)))
        ename (dxf -2 tdata)
  )
  (while (setq tblist (append tblist (list (entget ename)))
               ename (entnext ename)
  )      )
tblist
)

;*end of TBLIST.LSP
;;;;;;;) );test subroutines
(princ)

(princ "...Lisputil Loaded")