;ABKOUT function to wblock all blocks within a drawing

;Released into the public domain the the author, Sierra Hermitage
;
;Sierra Hermitage
;Rod Young, programmer
;140 Mesa Vista Drive
;Bishop, CA  93514
;Phone 619-387-2479 (voice)   619-387-2488 (data/fax, seldom enabled)
;E-mail hermit1@ix.netcom.com

;Intended to be used with RUN LISP to wblock all blocks
;within multiple drawings AUTOMATICALLY (See RUNLISP.TXT)

;You could use a script (yuck! is anyone still doing that?).
;Save yourself alot of time and order RUN LISP today.

;YOU must create a subdirectory off of the directory containing
;the drawing named BLOCKS  The wblocks will be written to that
;subdirectory

;If the same block name is found in multiple drawings, only
;the first will be wblocked.  Block names longer that eight
;characters will be truncated.

;Can be used with ASLDLIB.LSP and RUN LISP to automatically
;create a slide of each drawing and build the slide list
;file required as an argument by SLIDELIB.EXE to create
;a slide library (see ASLDLIB.TXT).

;SIERRA HERMITAGE 1995

;Sierra Hermitage
;Rod Young, programmer
;140 Mesa Vista Drive
;Bishop, CA  93514
;Phone: 619-387-2479


;subroutine to write out wblocks

(defun bout(path name)
	;truncate long block names
	(if (> (strlen name) 8)(setq pame(substr name 1 8))(setq pame name))
	;check if file exists - if so do nothing - if not write block out
	(if (not (findfile (strcat path name ".DWG")))
		(command "wblock" (strcat path pame) name)
	);end if	
);end defun

(defun abkout()
	;build the save block path
	(setq cname(getvar "dwgname"))
	(setq count 1)
	(repeat (strlen cname)
		(if (= (substr cname count 1) (chr 92))
			(setq mark (1- count))
		);end if
		(setq count (1+ count))
	);end repeat
	(if mark
		(setq nname(strcat (substr cname 1 mark) (chr 92) "BLOCKS" (chr 92)))
		(setq nname (strcat (getvar "DWGPREFIX") "BLOCKS" (chr 92)))
	);end if
	(setq bklist(tblnext "BLOCK" t))
	(setq bname(cdr(assoc 2 bklist)))
	(bout nname bname)
	(while(setq bklist(tblnext "BLOCK"))
		(setq bname(cdr(assoc 2 bklist)))
		(bout nname bname)
	);end while
);end defun
;make this program 'load & go' - do this for all RUN LISP compatible
;programs
(abkout)


	