;;; ;
;;; Manipulate multiple drawings at once ;
;;; ;
;;; Name : BaBe.lsp ;
;;; Created by: Joop F Moelee (c) ;
;;; Version : Beta 1.4 ;
;;; Org. Date : 15-03-2002 ;
;;; Rev. Date : 01-04-2004 (All Fools Day) Translated to English ;
;;; 10-05-2005 Now it works also with Acad 2005 ;
;;; 18-05-2005 Added the possibility to choose save/no-save ;
;;; 25-02-2008 Works now with 2007 and 2008 32 & 64 bit ;
;;; ;

(vl-load-com)

;;;*=====================================================================
;;; Main program =
;;;*=====================================================================
(defun c:BaBe ()
(LoadDoslib) ; We use several routines from it
(Initerr) ; Initialize my own error routine
(InitBaBe) ; Setup baBe's fundamentals
(SelectFiles) ; Select the files to be processed
(SelectManipulation) ; Select what we want to do
(SaveYesNo) ; Save drawing on close down
(MakeScript) ; Create the script file
(Reset) ; Restore environment
(setq ScriptLocation (strcat ScriptPath "BaBe.scr"))
(vl-cmdf "script" ScriptLocation ) ; Run script
) ;_ end of defun

;;;*=====================================================================
;;; Load DosLib functionalities =
;;;*=====================================================================
(defun LoadDoslib (/ ~ver )
(setq ~ver (substr (getvar "acadver") 1 2))
;;; Check for AutoCAD 2000, 2000i, or 2002
(if (= "15" ~ver)
(if (not (member "doslib15.arx" (arx)))
(if (findfile "doslib15.arx")
(arxload "doslib15")
) ;_ end of if
) ;_ end of if
) ;_ end of if
;;; Check for AutoCAD 2004, 2005, or 2006
(if (= "16" ~ver)
(if (not (member "doslib16.arx" (arx)))
(if (findfile "doslib16.arx")
(arxload "doslib16")
) ;_ end of if
) ;_ end of if
) ;_ end of if
;;; Check for AutoCAD 2007 to 2014 (32 or 64bit)
(if (> (atoi ~ver) 16)
(if
(vl-catch-all-error-p
(vl-catch-all-apply 'arxload (list (strcat "doslib" ~ver)))
) ;_ end of vl-catch-all-error-p
(progn
(arxload (strcat "doslib" ~ver "x64"))
) ;_ end of progn
) ;_ end of if
) ;_ end of if
) ;_ end of defun

;;;*=====================================================================
;;; Setup our BaBe's basics =
;;;*=====================================================================
(defun InitBaBe (/)
(setq IniLocation (dos_search "BaBe.ini" (getvar "acadprefix"))) ; where to find ini file
(setq BaBeLocation (dos_search "BaBe.lsp" (getvar "acadprefix"))) ; and this program
(if (= IniLocation nil) ; If not found ini file
(progn ; set the location for ini file
(setq SplitBaBeLocation
(dos_splitpath BaBeLocation)
BaBeLocationDrive
(car SplitBaBeLocation)
BaBeLocationPath
(cadr SplitBaBeLocation)
BaBeLocationDrivePath
(strcat BaBeLocationDrive BaBeLocationPath)
IniLocation
(strcat BaBeLocationDrive BaBeLocationPath "BaBe.ini")
) ;_ end of setq
(FirstTime)
) ;_ end of progn
(progn
(setq BasePath (dos_getini "SearchPath" "BasePath" IniLocation))
(setq LispPath (dos_getini "SearchPath" "LispPath" IniLocation))
(setq ScriptPath (dos_getini "SearchPath" "ScriptPath" IniLocation))
) ;_ end of progn
) ;_ end of if
) ;_ end of defun
end
of
defun

;;;*=====================================================================
;;; When there is no ini file, create one =
;;;*=====================================================================
(defun FirstTime (/)
(setq BasePath (dos_getdir "Select search path for drawings.")
LispPath (dos_getdir "Select directory with lisp files.")
ScriptPath (dos_getdir "Select directory for scripts.")
LispFiles (dos_getfilem "Select lisp files." BaBeLocationDrivePath)
) ;_ end of setq
(setq BasePath (ChangeBackslash BasePath))
(dos_setini "SearchPath" "BasePath" BasePath IniLocation)
(setq LispPath (ChangeBackslash LispPath))
(dos_setini "SearchPath" "LispPath" LispPath IniLocation)
(setq ScriptPath (ChangeBackslash ScriptPath))
(dos_setini "SearchPath" "ScriptPath" ScriptPath IniLocation)
) ;_ end of defun

;;;*=====================================================================
;;; Changes the Windows backslash into a forward slash =
;;; for processing by AutoCAD =
;;;*=====================================================================
(defun ChangeBackslash (PathToConvert /)
(setq PathToConvert (vl-string->list PathToConvert)
PathToConvert (subst 47 92 PathToConvert)
PathToConvert (vl-list->string PathToConvert)
) ;_ end of setq
) ;_ end of defun

;;;*=====================================================================
;;; Select files to be processed =
;;;*=====================================================================
(defun SelectFiles (/ SelectedFiles AmountOfFiles)
(setq SelectedFiles
(dos_getfilem
"Select Drawings"
;;; "O:\\AM-workflow\\DOCUMENT\\"
BasePath
"Drawing files (*.dwg)|*.dwg||"
) ;_ end of dos_getfilem
Path (car SelectedFiles)
SelectedFiles
(cdr SelectedFiles)
AmountOfFiles
(vl-list-length SelectedFiles)
SelectedFilesSorted
(acad_strlsort SelectedFiles)
path (ChangeBackslash path)
) ;_ end of setq
) ;_ end of defun

;;;*=====================================================================
;;; Select Lisp file that does the manipulation =
;;;*=====================================================================
(defun SelectManipulation (/)
(setq LispDir (dos_getini "SearchPath" "LispPath" IniLocation))
(setq ListOfLisp
(dos_dir (strcat lispdir "*.lsp"))
) ;_ end of setq
(setq SelectedManipulation
(strcat LispDir
(dos_listbox "Apropriate Lisp Files" "Select Lisp file" ListOfLisp)
) ;_ end of strcat
SelectedManipulation
(ChangeBackslash SelectedManipulation)
) ;_ end of setq
) ;_ end of defun

;;;*=====================================================================
;;; Select wether you want to save the changes made to the drawing =
;;; >>> When you only want to plot choose No =
;;; >>> Default is Yes =
;;;*=====================================================================
(defun SaveYesNo (/)
(setq SaveDrawing (dos_msgbox "Do you want to save the drawing?" "Save Drawing" 4 4))
(if (= SaveDrawing 6)
(setq DiscardChanges "N")
(setq DiscardChanges "Y")
) ;_ end of if
) ;_ end of defun

;;;*=====================================================================
;;; Make the scriptfile =
;;;*=====================================================================
(defun MakeScript (/)
(setq ScriptLocation (strcat ScriptPath "BaBe.scr"))
(if (= (dos_filep ScriptLocation) T)
(dos_delete ScriptLocation)
) ;_ end of if
(setq BaBeScript (open ScriptLocation "a"))
(foreach Drawing SelectedFilesSorted
(setq ScriptLine
(strcat "open"
" "
"\""
(strcat Path Drawing)
"\""
" "
"(load \""
SelectedManipulation
"\")"
" "
"close"
" "
DiscardChanges
) ;_ end of strcat
) ;_ end of setq
(write-line ScriptLine BaBeScript)
) ;_ end of foreach
(close BaBeScript)
) ;_ end of defun

;;;*=====================================================================
;;; Start error routine =
;;;*=====================================================================
(defun initerr (/)
(setq oldlayer (getvar "clayer"))
(setq oldsnap (getvar "osmode"))
(setq oldpick (getvar "pickbox"))
(setq temperr *error*)
(setq *error* trap)
(princ)
) ;_ end of defun

;;;*=====================================================================
;;; Error routine activated =
;;;*=====================================================================
(defun trap (errmsg /)
(command nil nil nil)
(if (not
(member errmsg '("console break" "Function Cancelled"))
) ;_ end of not
(princ (strcat "\nError: " errmsg))
) ;_ end of if
(setvar "clayer" oldlayer)
;;; (setvar "blipmode" 1)
(setvar "menuecho" 0)
(setvar "highlight" 1)
(setvar "osmode" oldsnap)
(setvar "pickbox" oldpick)
(if (= (dos_openp "c:\\temp\\print.scr") T)
(close "c:\\temp\\print.scr")
) ;_ end of if
(princ "\nError Resetting Enviroment ")
(terpri)
(setq *error* temperr)
(princ)
) ;_ end of defun

;;;*=====================================================================
;;; If error =
;;;*=====================================================================
(defun reset ()
(setq *error* temperr)
(setvar "clayer" oldlayer)
;;; (setvar "blipmode" 1)
(setvar "menuecho" 0)
(setvar "highlight" 1)
(setvar "osmode" oldsnap)
(setvar "pickbox" oldpick)
(princ)
) ;_ end of defun

;;;*=====================================================================
;;; =
;;;*=====================================================================
(princ "\nBaBe.lsp loaded. Type BABE to run.")
(princ)
(c:babe)
;|«Visual LISP© Format Options»
(100 2 40 2 T "end of " 80 9 0 0 nil T T nil T)
;*** DO NOT add text below the comment! ***|;

Advertisements