; abat.lsp acad dcl interface for AutoCAD Batch Utility
; written by: Paul Li
;;---------------------------------------------------------------------------
; Description:
; ABAT.lsp is an attempt to combine three available AutoCAD add on functions
; to ease the process of applying the same script file to multiple AutoCAD
; drawings.  ABAT.lsp provides a dialog interface within AutoCAD R14 to select 
; multiple drawing files with the help of Robert McNeel & Associates's DOSLIB 
; and Jim Fisher of CADre Computer Consultants' applications. The list of 
; drawings are then placed into a file read by the AutoCAD Batch Utility 
; program designed by Erik Murray-email: xanadu@uoli.com
;
;;---------------------------------------------------------------------------
;; Permission to use, copy, modify, and distribute this software for any
;; purpose and without fee is hereby granted.
;;
;; THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED WARRANTY.
;; ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR PURPOSE AND OF
;; MERCHCANTABILITY ARE HEREBY DISCLAIMED.
;;
;;---------------------------------------------------------------------------
(princ"\nLoading Multiple Drawing Batch Utility...")
(defun c:abat
 (/ abufile aname count cmdecho choz dwglst dwglstlen fname item lin menuecho outline scrfile abat_err abat_olderr GETMFILED)
  (defun abat_err (s)                 ; If an error (such as CTRL-C) occurs
   (if (/= s "Function cancelled")
      (princ (strcat "\nError: " s))
   )
   (if rname(close rname))(if fname(close fname))
   (if abat_olderr (setq *error* abat_olderr))  ; Restore old *error* handler
   (princ)
  )
;;---------------------------------------------------------------------------
;;
;;REVISED TO WORK WITH AUTOCAD R14's DOSLIB14.ARX
;;
;; Version 3.0
;;
;; Written by: Jim Fisher
;;             CADre Computer Consultants
;;             CIS ID# 74407,2437
;;             August 1994
;;
;;---------------------------------------------------------------------------
;;
;; Requires:
;;
;;   DOSLIB14 Version 4.0 or higher
;;   Copyright c 1992-1994, Robert McNeel & Associates
;;   3670 Woodland Park Avenue North
;;   Seattle, WA  98103
;;   (206) 545-7000
;;
;;   Permission to use, copy, modify, and distribute this software for any
;;   purpose and without fee is hereby granted, provided that the above
;;   copyright notice appears in all copies and that both that copyright
;;   notice and this permission notice appear in all supporting documentation.
;;
;;   Robert McNeel & Associates makes no warranty, including but not limited
;;   to any implied warranties of merchantability or fitness for a particular
;;   purpose, regarding the software and accompanying materials.  The software
;;   and accompanying materials are provided solely on an "as-is" basis.
;;
;;   In no event shall Robert McNeel & Associates be liable to any special,
;;   collateral, incidental, or consequential damages in connection with or
;;   arising out of the use of the software or accompanying materials.
;;
;;   * DOSLIB is a trademark of Robert McNeel & Associates.
;;   * AutoCAD, AutoLISP and ADS are registered trademarks of Autodesk, Inc.
;;   * MS-DOS and Windows are registered trademarks of Microsoft Corporation.
;;   * All other brands and product names are trademarks or registered
;;     trademarks of their respective holders.
;;
;;---------------------------------------------------------------------------
;;
;; Syntax:
;;
;;   (mgetfiled <title> <dfltPath> <dfltExt> <flags>)
;;
;;
;; Description:
;;
;;   'mgetfiled' is an AutoLISP subroutine with a dialog box interface
;;   which allows users to select multiple files for processing.  It is
;;   similar to the AutoLISP 'getfiled' function, and returns the selected
;;   files as a list. If no files are selected, or 'CANCEL' is pressed, it
;;   returns 'nil'.  It uses the 'acad_dlfmulti' dialog box as defined in
;;   ACAD.DCL, therefore no additional DCL file is required.  The 'title'
;;   argument specifies the label for the dialog box.  If the null string
;;   ("") is passed, 'title' defaults to " Select file(s): ".  The 'dfltPath'
;;   argument specifies a default path and file name pattern to use.  If the
;;   null string is passed, the drive and path default to the current drive
;;   and path and the file pattern defaults to '*'.  If the drive is not
;;   valid, the current drive is used.  The 'ext' argument specifies the
;;   default file name extension.  If the null string is passed, 'ext'
;;   defaults to '*'.  The 'flags' argument is an integer value (a bit-coded
;;   field) that controls the behavior of the dialog box.  To set more than
;;   one condition at a time, simply add the values together (in any
;;   combination) to create a 'flags' value between 0 and 15.  The 'flags'
;;   argument values and meanings are as follows:
;;
;;
;;   Value = 1 (bit 0) Controls drives available to user.  If set, any
;;                     available drives are not included in directory
;;                     listing. If not set, all available DOS drives will
;;                     be included.
;;
;;   Value = 2 (bit 1) Controls "Type it" button in 'getfiled'.  Not used in
;;                     this function. "Type it" is automatically disabled.
;;
;;   Value = 4 (bit 2) Controls availability of pattern edit box to the
;;                     user.  If set, the box is unavailable to the user
;;                     for editing. If not set, the pattern edit box will
;;                     be available and the user change the file name and
;;                     extension search criteria.
;;
;;   Value = 8 (bit 3) Controls list of files returned.  If set, the full
;;                     file name, including drive and path, is returned.
;;                     If not set, only the file name and extension will
;;                     be included.
;;
;;
;; Example:
;;
;;   (mgetfiled "Select file(s):" "e:/work/pc*" "dwg" 5)
;;
;;   In the above example the dialog box will appear as follows:
;;
;;   'Select file(s):' will appear in the dialog box label.  The initial
;;   directory will be set to '/work' on drive 'e:'. The pattern edit box
;;   will be set to 'pc*.dwg' and be unavailabe to the user for editing.
;;   The directory list will not include any drives.
;;
;;
;; Known problems:
;;
;;   Because AutoLISP is communicating with another program that is driving
;;   the dialog system, a size limit of is imposed for strings.  The maximum
;;   string size for passing between ADS and the dialog control system is
;;   255 characters; thus, it is assumed the interface between AutoLISP and
;;   the dialog system has the same limitation.  With this limitation, only
;;   60 to 80 elements can be sleectedat a time (depending on where you
;;   start in the list).
;;
;;---------------------------------------------------------------------------
;; Permission to use, copy, modify, and distribute this software for any
;; purpose and without fee is hereby granted.
;;
;; THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED WARRANTY.
;; ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR PURPOSE AND OF
;; MERCHCANTABILITY ARE HEREBY DISCLAIMED.
;;
;;---------------------------------------------------------------------------
;;
;; Revision history
;;
;;
;; 3.0  Supressed file extensions in file list box when wildcards are
;;      not used in file pattern. General code clean-up.
;;
;;
;; 2.0  Corrected problem updating "dirbox" tile when "default" button
;;      is selected.
;;
;;
;;===========================================================================
;;
;;
;; load time error checking

(if (findfile "ai_utils.lsp")
    (if (null ai_abort)
        (if (= "not" (load "ai_utils" "not"))
            (exit)
        )
    )
    (exit)
)

;;
;;===========================================================================
;;
;;
;; start of GETMFILED function
;;

(defun GETMFILED ( title dfltPath dfltExt flags
                 / DLExt oldErr oldEch oldDrv oldDir srtVal drvLst dfltDrv
                   dosLibFlag dfltPath dfltName drv path name ext dh filPat
                   dirLst filLst rtnList mgfSetup mgfSetupTiles mgfActions
                   mgfExits mgfReset mgfFilePat mgfDirs mgfFiles rsetErrTile
                   mgfChgDir mgfMkRtnLst numFilsPkd mgfSelAll mgfClrAll
                   mgfSetDflt mgfChkOut chkBit strPart rtnListLgth mgfError
                   addExt
                 )
;;
;; error handler
;;
   (defun mgfError (msg)
     (if (not (member msg '("Function cancelled"
                            "console break"
                            "quit / exit abort"
                            )
               )
          )
         (princ (strcat "\nError: " msg))
         (princ "\n")
     )
     (mgfReset)
     (princ)
   )
;;
;; setup AutoCAD envirnment
;;
   (defun mgfSetup ()
    (setq DLExt "DOSLIB14.ARX")
    ;if it's not already loaded, and it can be found, then load it
     (if (null dos_about)
        (if (findfile DLExt)
           (if (= "not" (arxload "doslib14" "not"))
              (ai_abort "DOSLIB14" (strcat "Can't load required file\n         " DLExt
                ".\n  Check support directories.")
              )
              (setq dosLibFlag T)
           )
           (ai_abort "DOSLIB" (strcat "Can't locate required file\n         " DLExt
            ".\n  Check support directories.")
           )
        )
     )
     (setq
       oldErr *error*               ;save & reset error handler
       *error* mgfError
       oldEch (getvar "cmdecho")    ;save: original 'cmdecho' value
       oldDrv (dos_drive)           ;      original drive
       oldDir (dos_pwdir)           ;      original directory
       srtVal (getvar "maxsort")
       drvLst (dos_drives)
       dfltPath (dos_splitpath dfltPath)
     )

     ;get initial drive for dialog box
     (cond
      ((= (car dfltPath) "")
       (setq dfltDrv oldDrv)
      )
      ((not (member (car dfltPath) drvLst))
       (setq dfltDrv oldDrv)
      )
      (T
       (setq dfltDrv (car dfltPath))
      )
     )

     ;get the default file name (if specified)
     (setq dfltName (caddr dfltPath))

     ;get initial path for dialog box
     (if (= (cadr dfltPath) "")
        (setq dfltPath (cadr (dos_splitpath (strcat oldDir "\\"))))
        (setq dfltPath (cadr dfltPath))
     )

     ;if it's not the root directory remove the trailing backslash
     (if (/= dfltPath "\\")
        (setq dfltPath (substr dfltPath 1 (- (strlen dfltPath) 1)))
     )
   )
;;
;; setup initial tile values for dialog box
;;
   (defun mgfSetupTiles ()
     (if (/= title "")
        (set_tile "dlfname" title)
        (set_tile "dlfname" " Select file(s): ")
     )
     (set_tile "pedit" filPat)
     (set_tile "dirtext" (dos_pwdir))
     (mgfDirs)
     (mgfFiles)
     (if (chkBit 4 flags)
        (mode_tile "pedit" 1)
     )
     (mode_tile "filebox" 2)   ;set initial focus to file list
     (mode_tile "typeit" 1)    ;disable 'typeit' button
     (mode_tile "fedit" 1)     ;disable 'File:' edit box
   )
;;
;; dialog box action expressions
;;
   (defun mgfActions ()
     (action_tile "pedit" "(rsetErrTile)(setq filPat $value)(mgfClrAll)(numFilsPkd)")
     (action_tile "dirbox" "(rsetErrTile)(if (= $reason 4)(mgfChgDir $value))(numFilsPkd)")
     (action_tile "filebox" "(rsetErrTile)(mgfMkRtnLst $value)(numFilsPkd)")
     (action_tile "all" "(rsetErrTile)(mgfSelAll)(numFilsPkd)")
     (action_tile "clear" "(rsetErrTile)(mgfClrAll)(numFilsPkd)")
     (action_tile "default" "(rsetErrTile)(mgfSetDflt)(numFilsPkd)")
     (action_tile "accept" "(rsetErrTile)(numFilsPkd)(mgfChkOut)")
     (action_tile "cancel" "(rsetErrTile)(done_dialog 0)")
     (action_tile "help" "(acad_helpdlg \"acad.hlp\" \"FILE_DIALOG,Select\")")
   )
;;
;; dialog box exit expressions
;;
   (defun mgfExits (ex)
     (cond

       ((= ex 1) ;ok button picked
        (unload_dialog dh)
        (mgfReset)
        (reverse rtnList)
       )

       ((= ex 0) ;cancel buttom picked
        (unload_dialog dh)
        (mgfReset)
        (eval nil)
       )
     )
   )
;;
;; reset AutoCAD environment
;;
   (defun mgfReset ()
     (dos_drive oldDrv)
     (dos_chdir oldDir)
     (setq *error* oldErr)
     (if dosLibFlag
        (arxunload "doslib14")
     )
     (setvar "cmdecho" oldEch)
   )
;;
;; get file pattern
;;
   (defun mgfFilePat (name ext)
     (if (= name "")
        (setq name "*")
     )
     (if (= ext "")
        (setq ext "*")
     )
     (setq filPat (strcat name "." ext))
   )
;;
;; get list of directories and drives and fill in dirbox tile
;;
   (defun mgfDirs (/ curDir tmpLst a)
     (setq
       dirLst (list "\\")
       curDir (dos_pwdir)
     )
     (setq tmpLst (dos_subdir curDir))
     (if (< (length tmpLst) srtVal)
        (setq tmpLst (acad_strlsort tmpLst))
     )
     (if (= (strlen (substr curDir 2)) 2)
        (setq dirLst tmpLst)
        (setq dirLst (append dirLst tmpLst))
     )
     (if (not (chkBit 1 flags))
        (progn
          (setq tmpLst drvLst)
          (foreach i tmpLst
            (setq a (strcat "<"i">"))
            (setq tmpLst (subst a i tmpLst))
          )
          (setq dirLst (append dirLst tmpLst))
        )
     )
     (start_list "dirbox")
     (mapcar 'add_list dirLst)
     (end_list)
   )
;;
;; get list of files and fill in filebox tile
;;
   (defun mgfFiles ()
     (setq
       filLst (dos_dir filPat)
       ext (strPart filPat "." "r")
     )
     (if filLst
        (progn

          (if (wcmatch ext "*`**,*`?*")
             (progn
               (if (< (length filLst) srtVal)
                  (setq filLst (acad_strlsort filLst))
               )
               (setq addExt nil)
             )
             (progn
               (foreach i filLst
                 (setq filLst (subst (strPart i "." "l") i filLst))
               )
               (if (< (length filLst) srtVal)
                  (setq filLst (acad_strlsort filLst))
               )
               (setq addExt T)
             )
          )
        )
     )
     (start_list "filebox")
     (mapcar 'add_list filLst)
     (end_list)
   )
;;
;; reset error tile to empty string
;;
   (defun rsetErrTile ()
      (set_tile "error" "")
   )
;;
;; change directory or drive to the value selected by the user and
;; update the necessary dialog box tiles
;;
   (defun mgfChgDir (where / tmp)
     (setq rtnList nil
           where (read where)
           tmp (nth where dirLst)
     )
     (cond
       ((= (substr tmp 1 1) "<")
        (setq drv (substr tmp 2 2))
        (if (= drv dfltDrv)
            (progn
              (dos_drive drv)
              (setq path (dos_chdir dfltPath))
            )
            (dos_drive drv)
        )
       )
       (T
        (setq path (dos_chdir tmp))
       )
     )
     (set_tile "dirtext" (dos_pwdir))
     (mgfDirs)
     (mgfClrAll)
   )
;;
;; make a list of files to return based on the user selection
;;
   (defun mgfMkRtnLst (what / tmp)
     (setq rtnList nil
           what (read (strcat "(" what ")"))
     )
     (cond
       ((< (length what) 1)
        (mode_tile "all" 0)
        (mode_tile "clear" 1)
       )
       ((= (length what)(length filLst))
        (mode_tile "all" 1)
        (mode_tile "clear" 0)
       )
       (T
        (mode_tile "all" 0)
        (mode_tile "clear" 0)
       )
     )
     (foreach x what
       (setq tmp (nth x filLst))
       (if (chkBit 8 flags)
          (if (/= path "\\")
;             (setq tmp (strcat (get_tile "dirtext") "\\" tmp))
;             (setq tmp (strcat drv "\\" tmp))
             (setq tmp (strcat (get_tile "dirtext") tmp))
             (setq tmp (strcat drv tmp))
          )
       )
       (if addExt
          (setq tmp (strcat tmp "." (strcase ext)))
       )
       (setq rtnList (cons tmp rtnList))
     )
   )
;;
;; set error tile to number of files selected
;;
   (defun numFilsPkd ()
     (if (> (setq rtnListLgth (length rtnList)) 0)
        (set_tile "error" (strcat (itoa rtnListLgth) " file(s) selected."))
        (set_tile "error" "")
     )
   )
;;
;; select all files
;;
   (defun mgfSelAll (/ i)
     (mode_tile "all" 1)
     (mode_tile "clear" 0)
     (setq i 0)
     (repeat (length filLst)
       (set_tile "filebox" (itoa i))
       (setq i (+ i 1))
     )
     (setq rtnList (mgfMkRtnLst (get_tile "filebox")))
   )
;;
;; clear all files
;;
   (defun mgfClrAll ()
     (mode_tile "all" 0)
     (mode_tile "clear" 1)
     (mgfFiles)
     (setq rtnList nil)
   )
;;
;; restore dialog box to original passed values
;;
   (defun mgfSetDflt ()
     (dos_drive dfltDrv)
     (dos_chdir dfltPath)
     (set_tile "pedit" (mgfFilePat dfltName dfltExt))
     (mgfDirs)
     (set_tile "dirtext" (dos_pwdir))
     (mgfClrAll)
   )
;;
;; check for file list if ok is pressed
;;
   (defun mgfChkOut ()
     (if (not rtnList)
        (progn
          (set_tile "error" "Invalid or empty file specification")
          (mode_tile "filebox" 2)
        )
        (done_dialog 1)
     )
   )
;;
;; check the status of bit in flags value
;;
   (defun chkBit (num value)            ;num is bit VALUE bit number
      (not (zerop (logand num value)))  ;value is number to test against
   )
;;
;; subroutine to get part of a string on either left or right of a character
;;
   (defun strPart (str sym side / a newstr)
     (if (= (type str) 'STR)
        (cond
          ((= side "l")
           (setq
             a (substr str 2 1)
             newstr (substr str 1 1)
             str (substr str 2)
           )
           (while (/= sym a)
             (setq
               newstr (strcat newstr (substr str 1 1))
               str (substr str 2)
               a (substr str 1 1)
             )
           )
           (eval newstr)
          )
          ((= side "r")
           (setq
             a (substr str 1 1)
             str (substr str 2)
           )
           (while (/= sym a)
             (setq
               a (substr str 1 1)
               str (substr str 2)
             )
           )
          )
        )
     )
   )
;;
;; main function
;;
     (mgfSetup)
     (setq
       drv dfltDrv
       path dfltPath
       name dfltName
       ext dfltExt
       filPat (mgfFilePat name ext)
     )
     (dos_drive drv)
     (dos_chdir path)
     (setq dh (load_dialog "acad"))
     (if (and dh (new_dialog "acad_dlfmulti" dh))
         (progn
           (mgfSetupTiles)
           (mgfActions)
           (mgfExits (start_dialog))
         )
     )
)
;
; begin dialog drawing selection section
;
 (setq abat_olderr  *error*              ; Save error routine
        *error* abat_err           ; Substitute ours
 )
 (setq cmdecho(getvar"cmdecho"))
 (setq menuecho(getvar"menuecho"))
 (setvar"menuecho"1)(setvar"cmdecho"0)
  (if(not ac_abat_choz)(setq ac_abat_choz "Create"))
  (initget "Create Load Merge")
  (setq choz(getkword(strcat"\n<C>reate or <L>oad or <M>erge Batch Script File? <" ac_abat_choz ">: ")))
  (if(not choz)(setq choz ac_abat_choz)(setq ac_abat_choz choz))
(cond
 ((= choz "Merge")
 (setq dwglst(getmfiled"Select BatchScript Files to Merge:"(getvar"dwgprefix")"abu"14))
 (if dwglst
  (if(listp dwglst)
    (if(not(zerop(setq dwglstlen(length dwglst))))
     (progn
      (setq abufile(getfiled"New BatchScript File to Create:" "" "abu"1))
      (if abufile
	(progn
           (setq fname (open abufile "w"))
           (write-line "AutoCAD Batch Utility v3.0" fname)
           (write-line "" fname)
           (write-line "" fname)
           (setq item 0)
           (repeat dwglstlen
	     (setq aname(open(nth item dwglst)"r"))
             (setq lin(read-line aname))
	     (while lin
	       (if(wcmatch lin "*|*")
		 (write-line lin fname)
	       )
               (setq lin(read-line aname))
	     )
             (setq item (1+ item))
           ) ; repeat
           (close fname)
           (princ"\nStarting Batch Utility.")
           (command"_.shell" (strcat "start " abufile))
          ) ;progn
          (princ"\nNew BatchScript File NOT Given...Function Cancelled.")
        ) ;if script files
     ) ;progn
    ) ; if
    (princ"\nNo BatchScript Files Selected.")
  ) ; if 
 ) ; if dwglst
 ) ; Merge
 ((= choz "Create")
 (setq dwglst(getmfiled"Select Drawings For Scripting"(getvar"dwgprefix")"dwg"14))
 (if dwglst
  (if(listp dwglst)
    (if(not(zerop(setq dwglstlen(length dwglst))))
     (progn
      (setq scrfile(getfiled"Script File to Use on Drawings:" "" "scr"0))
      (if scrfile
	(progn
         (setq abufile(getfiled"BatchScript File to Create:" "" "abu"1))
         (if abufile
          (progn
           (setq fname (open abufile "w"))
           (write-line "AutoCAD Batch Utility v3.0" fname)
           (write-line scrfile fname)
           (write-line "" fname)
           (write-line "" fname)
           (setq item 0)
           (repeat dwglstlen
             (write-line (strcat(nth item dwglst)"|"scrfile) fname)
             (setq item (1+ item))
           )
           (close fname)
           (princ"\nStarting Batch Utility.")
           (command"_.shell" (strcat "start " abufile))
          ) ;progn
          (princ"\nBatchScript File NOT Given...Function Cancelled.")
        ) ;if script files
       ) ;progn
       (princ"\nScript File NOT Selected...Function Cancelled.")
      ) ; if
     ) ;progn
    ) ; if
    (princ"\nNo Drawings Selected.")
 ) ; if
) ; if
); Create
((= choz "Load")
  (setq abufile(getfiled"BatchScript File to Load:" "" "abu"0))
  (if abufile
    (progn
     (princ"\nStarting Batch Utility.")
     (command"_.shell" (strcat "start " abufile))
    )
    (princ"\nBatchScript File NOT Given...Function Cancelled.")
  ) ; if
 ) ; Load
) ; cond
 (setvar"menuecho"menuecho)(setvar"cmdecho"cmdecho)
 (if abat_olderr (setq *error* abat_olderr))  ; Restore old *error* handler
 (princ)
) ; defun
(princ"\n...Loaded.  To Start Command type  Abat.")(princ)