home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Overload
/
ShartewareOverload.cdr
/
games
/
misc_lsp.zip
/
DWGDAT.LSP
< prev
next >
Wrap
Text File
|
1988-02-21
|
2KB
|
50 lines
(defun C:DATE(/ td time j y d m ys ms ds hh hs mm mss ss sss place rotn rot dwg)
; Richard Henley 73260,2346 Scanlon and Associates, Albuquerque NM
; Lisp Routine to Place Current Time, Date and Drawing Name at selected
; location and rotation (entered or picked)
; The Current Text Height should not be 0
(setq td (getvar "date"))
(setq time (* 86400.0 (- td (setq j (fix td)))))
(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 ys (rtos y 2 0))
(setq ms (itoa m))
(setq ds (itoa d))
(setq hh (fix (/ time 3600.0)))
(setq hs (itoa hh))
(setq time (- time (* hh 3600.0)))
(setq mm (fix (/ time 60.0)))
(setq mss (itoa mm))
(setq ss (- time (* mm 60.0)))
(setq sss (rtos ss 2 0))
(setq dt (strcat "Date: " ms "/" ds "/" ys))
(setq dt2 (strcat "Time: " hs ":" mss ":" sss))
(setq place
(getpoint "Enter point to place Date/Time/Drawing File Name Stamp: "))
(setq rotn (getangle place "Enter Text Rotation <0.0>: "))
(if (null rotn) (setq rot "0.0") (setq rot (angtos rotn 0 6)))
(setq dwg (strcat "Drawing File: " (strcase (getvar "dwgname"))))
(command "text" place rot dt2)
(command "text" "" dt)
(command "text" "" dwg)
(princ)
)