;pstamp function to date stamp a drawing during plotting
;and update any other blocks to current system variable values

;this program is intended to be used with RUN LISP (see RUNLISP.TXT)
;to do batch plotting

;simply select this program in RUN LISP to be run prior to
;your plotting program

;blocks to be updated must be named after the system variable
;containing the update information and the first attribute will
;be updated to the current value

;so, if you want to date stamp your drawings prior to plotting
;simply have a block at the desired location named CDATE that
;has its first attribute the in location at which you want the
;date stamp.

;other system variables may also be updated in the same manner.
;this program is written to update CDATE, DWGNAME, LTSCALE and
;LOGINNAME - it should be obvious how to add additional ones
;if needed

;if used with RUN LISP (see RUNLISP.TXT) the DWGNAME variable
;contains the complete path to the drawing

** subroutine to return date/time, given julian date ***

;;;   Scab from Julian.lsp
;;;   (C) Copyright 1988-1993 by Autodesk, Inc.
;;;	Rewrote as subroutine - Sierra Hermitage


(defun dateconv(jd)
	(setq time (* 86400.0 (- jd (setq j (fix jd)))))
	(setq j (- j 1721119.0))
	(setq y (fix (/ (1- (* 4 j)) 146097.0)))
	(setq j (- (* j 4.0) 1.0 (* 146097.0 y)))
	(setq d (fix (/ j 4.0)))
	(setq j (fix (/ (+ (* 4.0 d) 3.0) 1461.0)))
	(setq d (- (+ (* 4.0 d) 3.0) (* 1461.0 j)))
	(setq d (fix (/ (+ d 4.0) 4.0)))
	(setq m (fix (/ (- (* 5.0 d) 3) 153.0)))
	(setq d (- (* 5.0 d) 3.0 (* 153.0 m)))
	(setq d (fix (/ (+ d 5.0) 5.0)))
	(setq y (+ (* 100.0 y) j))
	(if (< m 10.0)
		(setq m (+ m 3))
		(progn	
			(setq m (- m 9))
			(setq y (1+ y))
		)
	)	
	(setq datefix (strcat (itoa(fix y)) "/" (pleft(itoa(fix m))) "/" (pleft(itoa(fix d)))))
	(setq hh (fix (/ time 3600.0)))
	(setq time (- time (* hh 3600.00)))
	(setq mm (fix (/ time 60.0)))
	(setq ss (fix(- time (* mm 60.0))))
	(setq timefix(strcat " " (pleft(itoa hh)) ":" (pleft(itoa mm)) ":" (pleft(itoa ss))))
	(setq tconv(strcat datefix timefix))
)

** subroutine to fix time **

(defun timeconv(time)
	(setq time (* time 86400.0))
	(setq hh (fix (/ time 3600.0)))
	(setq time (- time (* hh 3600.00)))
	(setq mm (fix (/ time 60.0)))
	(setq ss (fix(- time (* mm 60.0))))
	(setq timefix(strcat (pleft(itoa hh)) ":" (pleft(itoa mm)) ":" (pleft(itoa ss))))
);end defun

** subroutine to pad zero **

(defun pleft(strg)
	(if (= (strlen strg) 1)(setq strg(strcat "0" strg))(setq strg strg))
)	

(defun pstamp()
	(setq blist'("CDATE" "DWGNAME" "LTSCALE" "LOGINNAME"))	;add any others you wish
	(setq blks(ssget "X" '((0 . "INSERT"))))	;get all blocks
	(foreach bname blist
		(if (= bname "CDATE")
			(setq nname (dateconv (getvar "CDATE")))
			(setq nname (getvar bname))				;get current value
		);end if
		(if (numberp nname)(setq nname (rtos nname 2)))		
		(setq count 0)
		(while (< count (sslength blks))
			(setq bent (cdr(assoc 2(entget (ssname blks count)))))
			(if (= bent bname)	;if block found
			 (progn
				(setq attrent(entget(entnext (ssname blks count))))	;get attr
				(setq attrent
					(subst (cons 1 nname)
							 (assoc 1 attrent)
							 attrent
					)
				)
				(entmod attrent)
				(entupd (ssname blks count))
			 );end progn
			);end if
			(setq count (1+ count))
		);end while
	);end foreach
);end defun
(pstamp)	;make this program "load & go"
				
