- 积分
- 240
- 明经币
- 个
- 注册时间
- 2002-8-23
- 在线时间
- 小时
- 威望
-
- 金钱
- 个
- 贡献
-
- 激情
-
|
发表于 2004-12-21 16:46:00
|
显示全部楼层
我在日本时编的一个时钟程序,按照输入的秒数运行。
;;; T M . L S P ;;; Copyright * 2002/04/12 by SongXiaoDong(@_@), ShuFu Co. ;;; version 1.0 (In TOKYO Japan)
(defun C:TM (/ x ssc ssc1 mmc mmc1 hhc hhc1 tm hh ss ss1 mm ssang hhang mmang oo shx fnx n var1 var2 var3 var4 var5 var6 yun1 yun2 yun3 yun hc1 hc2 mc1 mc2 sc1 sc2 jx0 jx1 jx2 jx3 jx4 jx5 jx0b jx1b jx2b jx3b jx4b jx5b jxjh jx jxz ) (vl-load-com) (setq var1 (getvar "angbase")) (setq var2 (getvar "angdir")) (setq var3 (getvar "cmdecho")) (setq var4 (getvar "ucsicon")) (setq var5 (getvar "osmode")) (setq var6 (getvar "dimzin")) (setvar "osmode" 0) (setvar "angbase" (/ pi 2)) (setvar "angdir" 1) (setvar "cmdecho" 0) (setvar "ucsicon" 2) (setvar "dimzin" 1) (dztm)
(defun dtr (a) (* pi (/ a 180.0)) ) ;_ end of defun
(defun tmb () (setq tm (rtos (getvar "cdate") 2 8)) (setq hho (atof (substr tm 10 2))) (if (> hho 12) (progn (setq hh (- hho 12)) (setq apm "下午") ) ;_ end of progn (progn (setq hh hho) (setq apm "上午") ) ;_ end of progn ) ;_ end of if (setq mm (atof (substr tm 12 2))) (setq ss (atof (substr tm 14 2))) (setq yun1 (atof (substr tm 17))) (setq yun2 (atof (substr tm 16 1))) (setq yun3 (atof (substr tm 15 1))) (setq yun (+ (* yun3 100) (* yun2 10) yun1)) (setq ssang (* 6 ss)) (setq mmang (+ (* 6 mm) (* 0.1 ss))) (setq hhang (+ (* 30 hh) (* 0.5 mm))) (setq hc1 (strcat "X_" (itoa (fix (/ hho 10))))) (setq hc2 (strcat "X_" (itoa (fix (rem hho 10))))) (setq mc1 (strcat "X_" (itoa (fix (/ mm 10))))) (setq mc2 (strcat "X_" (itoa (fix (rem mm 10))))) (setq sc1 (strcat "X_" (itoa (fix (/ ss 10))))) (setq sc2 (strcat "X_" (itoa (fix (rem ss 10))))) (setq ssc (strcat "@90<" (rtos ssang 2 4))) (setq mmc (strcat "@80<" (rtos mmang 2 4))) (setq hhc (strcat "@70<" (rtos hhang 2 4))) ) ;_ end of defun
(setq x (getint "运行秒数<5>:")) (if (= x nil) (setq x 5) ) ;_ end of if (setq oo '(0.0 0.0 0.0)) (command "zoom" "a") (command "zoom" "w" "-110,110" "110,-150") (command "regen") (while (= tmk nil) (command "color" 91) (command "donut" 0 10 oo "") (setq hhy (ssget "L")) (command "color" 4) (command "line" "0,100" "0,95" "") (setq fnx (ssget "L")) (command "array" fnx "" "p" oo 60 "" "") (command "color" 141) (command "pline" "0,100" "w" 2 2 "0,90" "") (setq shx (ssget "L")) (command "array" shx "" "p" oo 12 "" "") (command "color" 150) (command "donut" 200 202 oo "") (command "color" "yellow") (command "donut" 0 2 "-16,-120" "-16,-130" "16,-120" "16,-130" "" ) ;_ end of command (command "color" "magenta") (command "rectang" "-50,-110" "50,-140") (setq tmk 1) ) ;_ end of while (setq n 0) (setq jx0 0.0) (setq jx1 0.0) (setq jx2 0.0) (setq jx3 0.0) (setq jx4 0.0) (setq jx5 0.0)
(while (<= n x) (tmb) (if (/= hhc hhc1) (progn (command "color" 11) (if (/= hhc0 nil) (command "erase" hhc0 "") ) ;_ end of if (command "pline" oo "w" 10 0 hhc "") (setq hhc0 (ssget "L")) ) ;_ end of progn ) ;_ end of if (if (/= mmc mmc1) (progn (command "color" 51) (if (/= mmc0 nil) (command "erase" mmc0 "") ) ;_ end of if (command "pline" oo "w" 6 0 mmc "") (setq mmc0 (ssget "L")) ) ;_ end of progn ) ;_ end of if (if (/= ssc ssc1) (progn (command "color" 161) (if (/= ssc0 nil) (command "erase" ssc0 "") ) ;_ end of if (command "pline" oo "w" 2 0 ssc "") (setq ssc0 (ssget "L")) (command "rotate" hhy "" oo 1) ) ;_ end of progn ) ;_ end of if (if (/= hhc hhc1) (progn (command "color" "cyan") (if (/= h1 nil) (command "erase" h1 "") ) ;_ end of if (command "-insert" hc1 "-40,-125" "" "" "") (setq h1 (ssget "L")) (if (/= h2 nil) (command "erase" h2 "") ) ;_ end of if (command "-insert" hc2 "-26,-125" "" "" "") (setq h2 (ssget "L")) ) ;_ end of progn ) ;_ end of if (if (/= mmc mmc1) (progn (command "color" "cyan") (if (/= m1 nil) (command "erase" m1 "") ) ;_ end of if (command "-insert" mc1 "-7,-125" "" "" "") (setq m1 (ssget "L")) (if (/= m2 nil) (command "erase" m2 "") ) ;_ end of if (command "-insert" mc2 "7,-125" "" "" "") (setq m2 (ssget "L")) ) ;_ end of progn ) ;_ end of if (if (/= ssc ssc1) (progn (command "color" "cyan") (if (/= s1 nil) (command "erase" s1 "") ) ;_ end of if (command "-insert" sc1 "26,-125" "" "" "") (setq s1 (ssget "L")) (if (/= s2 nil) (command "erase" s2 "") ) ;_ end of if (command "-insert" sc2 "40,-125" "" "" "") (setq s2 (ssget "L")) ) ;_ end of progn ) ;_ end of if (setq yuns (fix (+ (* 13 (/ yun 1000)) 1))) (cond ((= yuns 1) (setq jx0 (1+ jx0)) ) ((and (> yuns 1) (< yuns 4)) (setq jx1 (1+ jx1)) ) ((and (> yuns 3) (< yuns 8)) (setq jx2 (1+ jx2)) ) ((and (> yuns 7) (< yuns 11)) (setq jx3 (1+ jx3)) ) ((and (> yuns 10) (< yuns 13)) (setq jx4 (1+ jx4)) ) ((= yuns 13) (setq jx5 (1+ jx5)) ) ) ;_ end of cond (setq ssc1 ssc) (setq mmc1 mmc) (setq hhc1 hhc) (if (/= ss ss1) (progn (setq n (1+ n)) (setq ss1 ss) ) ;_ end of progn ) ;_ end of if ) ;_ end of while (print jx0) (print jx1) (print jx2) (print jx3) (print jx4) (print jx5) (setq jxz (+ jx0 jx1 jx2 jx3 jx4 jx5)) (setq jx0b (- (/ jx0 jxz) (/ 1.0 13))) (setq jx1b (- (/ jx1 jxz) (/ 2.0 13))) (setq jx2b (- (/ jx2 jxz) (/ 4.0 13))) (setq jx3b (- (/ jx3 jxz) (/ 3.0 13))) (setq jx4b (- (/ jx4 jxz) (/ 2.0 13))) (setq jx5b (- (/ jx5 jxz) (/ 1.0 13))) (setq jxjh (list jx0b jx1b jx2b jx3b jx4b jx5b)) (setq jxjh (vl-sort jxjh (function (lambda (e1 e2) (> e1 e2))) ) ;_ end of vl-sort ) ;_ end of setq ;;;**************吉凶判定****************;;; (cond ((eq (nth 0 jxjh) jx0b) (setq jx "(#X_X#)大凶(#X_X#)") ) ((eq (nth 0 jxjh) jx1b) (setq jx "(#v_v#)凶(#v_v#)") ) ((eq (nth 0 jxjh) jx2b) (setq jx "(*@_@*)吉(*@_@*)") ) ((eq (nth 0 jxjh) jx3b) (setq jx "(*'_'*)小吉(*'_'*)") ) ((eq (nth 0 jxjh) jx4b) (setq jx "(*~v~*)中吉(*~v~*)") ) ((eq (nth 0 jxjh) jx5b) (setq jx "(*^o^*)大吉(*^o^*)") ) ) ;;;*************吉凶判定完***************;;; (setq nn (substr tm 1 4)) (setq yy (substr tm 5 2)) (setq rr (substr tm 7 2)) (setq tmt (strcat " 今天是:" nn "年" yy "月" rr "日" "\n" "\n")) (setq tmt (strcat tmt " 现在的时间:" apm (itoa (fix hh)) "时" (itoa (fix mm)) "分" (itoa (fix ss)) "秒" "\n" "\n" ) ;_ end of strcat ) ;_ end of setq (setq tmt (strcat tmt "现在的运势:" jx)) (command "color" "bylayer") (command "zoom" "p") (setvar "angbase" var1) (setvar "angdir" var2) (setvar "cmdecho" var3) (setvar "ucsicon" var4) (setvar "osmode" var5) (setvar "dimzin" var6) (alert tmt) (setvar "modemacro" "$(edtime,$(getvar,date),YYYY-MON-DD+DDDD-HH:MM:SS)" ) ;_ end of setvar
(princ) ) ;_ end of defun
(defun dztm () (if (not (tblsearch "block" "X_0")) (mk_x0) ) ;_ end of if (if (not (tblsearch "block" "X_1")) (mk_x1) ) ;_ end of if (if (not (tblsearch "block" "X_2")) (mk_x2) ) ;_ end of if (if (not (tblsearch "block" "X_3")) (mk_x3) ) ;_ end of if (if (not (tblsearch "block" "X_4")) (mk_x4) ) ;_ end of if (if (not (tblsearch "block" "X_5")) (mk_x5) ) ;_ end of if (if (not (tblsearch "block" "X_6")) (mk_x6) ) ;_ end of if (if (not (tblsearch "block" "X_7")) (mk_x7) ) ;_ end of if (if (not (tblsearch "block" "X_8")) (mk_x8) ) ;_ end of if (if (not (tblsearch "block" "X_9")) (mk_x9) ) ;_ end of if ) ;_ end of defun ;;;********************************************* (defun mk_x0 () (command "color" "BYBLOCK") (entmake '((0 . "BLOCK") (2 . "X_0") (70 . 0) (10 0.0 0.0 0.0) ) ) ;_ end of entmake (dz1) (dz2) (dz3) (dz4) (dz5) (dz6) (entmake '((0 . "ENDBLK"))) (command "color" "BYLAYER") ) ;_ end of defun ;;;********************************************* (defun mk_x1 () (command "color" "BYBLOCK") (entmake '((0 . "BLOCK") (2 . "X_1") (70 . 0) (10 0.0 0.0 0.0) ) ) ;_ end of entmake (dz3) (dz4) (entmake '((0 . "ENDBLK"))) (command "color" "BYLAYER") ) ;_ end of defun ;;;********************************************* (defun mk_x2 () (command "color" "BYBLOCK") (entmake '((0 . "BLOCK") (2 . "X_2") (70 . 0) (10 0.0 0.0 0.0) ) ) ;_ end of entmake (dz0) (dz2) (dz3) (dz5) (dz6) (entmake '((0 . "ENDBLK"))) (command "color" "BYLAYER") ) ;_ end of defun ;;;********************************************* (defun mk_x3 () (command "color" "BYBLOCK") (entmake '((0 . "BLOCK") (2 . "X_3") (70 . 0) (10 0.0 0.0 0.0) ) ) ;_ end of entmake (dz0) (dz2) (dz3) (dz4) (dz5) (entmake '((0 . "ENDBLK"))) (command "color" "BYLAYER") ) ;_ end of defun ;;;********************************************* (defun mk_x4 () (command "color" "BYBLOCK") (entmake '((0 . "BLOCK") (2 . "X_4") (70 . 0) (10 0.0 0.0 0.0) ) ) ;_ end of entmake (dz0) (dz1) (dz3) (dz4) (entmake '((0 . "ENDBLK"))) (command "color" "BYLAYER") ) ;_ end of defun ;;;********************************************* (defun mk_x5 () (command "color" "BYBLOCK") (entmake '((0 . "BLOCK") (2 . "X_5") (70 . 0) (10 0.0 0.0 0.0) ) ) ;_ end of entmake (dz0) (dz1) (dz2) (dz4) (dz5) (entmake '((0 . "ENDBLK"))) (command "color" "BYLAYER") ) ;_ end of defun ;;;********************************************* (defun mk_x6 () (command "color" "BYBLOCK") (entmake '((0 . "BLOCK") (2 . "X_6") (70 . 0) (10 0.0 0.0 0.0) ) ) ;_ end of entmake (dz0) (dz1) (dz2) (dz4) (dz5) (dz6) (entmake '((0 . "ENDBLK"))) (command "color" "BYLAYER") ) ;_ end of defun ;;;********************************************* (defun mk_x7 () (command "color" "BYBLOCK") (entmake '((0 . "BLOCK") (2 . "X_7") (70 . 0) (10 0.0 0.0 0.0) ) ) ;_ end of entmake (dz2) (dz3) (dz4) (entmake '((0 . "ENDBLK"))) (command "color" "BYLAYER") ) ;_ end of defun ;;;********************************************* (defun mk_x8 () (command "color" "BYBLOCK") (entmake '((0 . "BLOCK") (2 . "X_8") (70 . 0) (10 0.0 0.0 0.0) ) ) ;_ end of entmake (dz0) (dz1) (dz2) (dz3) (dz4) (dz5) (dz6) (entmake '((0 . "ENDBLK"))) (command "color" "BYLAYER") ) ;_ end of defun ;;;********************************************* (defun mk_x9 () (command "color" "BYBLOCK") (entmake '((0 . "BLOCK") (2 . "X_9") (70 . 0) (10 0.0 0.0 0.0) ) ) ;_ end of entmake (dz0) (dz1) (dz2) (dz3) (dz4) (dz5) (entmake '((0 . "ENDBLK"))) (command "color" "BYLAYER") ) ;_ end of defun ;;;*********************************************
(defun dz0 () (entmake '((0 . "POLYLINE") (66 . 1) ) ) ;_ end of entmake (entmake '((0 . "VERTEX") (10 -4.5 0.0 0.0) (40 . 0.0) (41 . 2.0) ) ) ;_ end of entmake (entmake '((0 . "VERTEX") (10 -3.0 0.0 0.0) (40 . 2.0) (41 . 2.0) ) ) ;_ end of entmake (entmake '((0 . "VERTEX") (10 3.0 0.0 0.0) (40 . 2.0) (41 . 0.0) ) ) ;_ end of entmake (entmake '((0 . "VERTEX") (10 4.5 0.0 0.0) (40 . 0.0) (41 . 0.0) ) ) ;_ end of entmake (entmake '((0 . "SEQEnd"))) ) ;_ end of defun ;;;############################################# (defun dz1 () (entmake '((0 . "POLYLINE") (66 . 1) ) ) ;_ end of entmake (entmake '((0 . "VERTEX") (10 -5.0 0.5 0.0) (40 . 0.0) (41 . 2.0) ) ) ;_ end of entmake (entmake '((0 . "VERTEX") (10 -5.0 2.0 0.0) (40 . 2.0) (41 . 2.0) ) ) ;_ end of entmake (entmake '((0 . "VERTEX") (10 -5.0 8.0 0.0) (40 . 2.0) (41 . 0.0) ) ) ;_ end of entmake (entmake '((0 . "VERTEX") (10 -5.0 9.5 0.0) (40 . 0.0) (41 . 0.0) ) ) ;_ end of entmake (entmake '((0 . "SEQEnd"))) ) ;_ end of defun ;;;############################################# (defun dz2 () (entmake '((0 . "POLYLINE") (66 . 1) ) ) ;_ end of entmake (entmake '((0 . "VERTEX") (10 -4.5 10.0 0.0) (40 . 0.0) (41 . 2.0) ) ) ;_ end of entmake (entmake '((0 . "VERTEX") (10 -3.0 10.0 0.0) (40 . 2.0) (41 . 2.0) ) ) ;_ end of entmake (entmake '((0 . "VERTEX") (10 3.0 10.0 0.0) (40 . 2.0) (41 . 0.0) ) ) ;_ end of entmake (entmake '((0 . "VERTEX") (10 4.5 10.0 0.0) (40 . 0.0) (41 . 0.0) ) ) ;_ end of entmake (entmake '((0 . "SEQEnd"))) ) ;_ end of defun ;;;############################################# (defun dz3 () (entmake '((0 . "POLYLINE") (66 . 1) ) ) ;_ end of entmake (entmake '((0 . "VERTEX") (10 5.0 0.5 0.0) (40 . 0.0) (41 . 2.0) ) ) ;_ end of entmake (entmake '((0 . "VERTEX") (10 5.0 2.0 0.0) (40 . 2.0) (41 . 2.0) ) ) ;_ end of entmake (entmake '((0 . "VERTEX") (10 5.0 8.0 0.0) (40 . 2.0) (41 . 0.0) ) ) ;_ end of entmake (entmake '((0 . "VERTEX") (10 5.0 9.5 0.0) (40 . 0.0) (41 . 0.0) ) ) ;_ end of entmake (entmake '((0 . "SEQEnd"))) ) ;_ end of defun ;;;############################################# (defun dz4 () (entmake '((0 . "POLYLINE") (66 . 1) ) ) ;_ end of entmake (entmake '((0 . "VERTEX") (10 5.0 -0.5 0.0) (40 . 0.0) (41 . 2.0) ) ) ;_ end of entmake (entmake '((0 . "VERTEX") (10 5.0 -2.0 0.0) (40 . 2.0) (41 . 2.0) ) ) ;_ end of entmake (entmake '((0 . "VERTEX") (10 5.0 -8.0 0.0) (40 . 2.0) (41 . 0.0) ) ) ;_ end of entmake (entmake '((0 . "VERTEX") (10 5.0 -9.5 0.0) (40 . 0.0) (41 . 0.0) ) ) ;_ end of entmake (entmake '((0 . "SEQEnd"))) ) ;_ end of defun ;;;############################################# (defun dz5 () (entmake '((0 . "POLYLINE") (66 . 1) ) ) ;_ end of entmake (entmake '((0 . "VERTEX") (10 -4.5 -10.0 0.0) (40 . 0.0) (41 . 2.0) ) ) ;_ end of entmake (entmake '((0 . "VERTEX") (10 -3.0 -10.0 0.0) (40 . 2.0) (41 . 2.0) ) ) ;_ end of entmake (entmake '((0 . "VERTEX") (10 3.0 -10.0 0.0) (40 . 2.0) (41 . 0.0) ) ) ;_ end of entmake (entmake '((0 . "VERTEX") (10 4.5 -10.0 0.0) (40 . 0.0) (41 . 0.0) ) ) ;_ end of entmake (entmake '((0 . "SEQEnd"))) ) ;_ end of defun ;;;############################################# (defun dz6 () (entmake '((0 . "POLYLINE") (66 . 1) ) ) ;_ end of entmake (entmake '((0 . "VERTEX") (10 -5.0 -0.5 0.0) (40 . 0.0) (41 . 2.0) ) ) ;_ end of entmake (entmake '((0 . "VERTEX") (10 -5.0 -2.0 0.0) (40 . 2.0) (41 . 2.0) ) ) ;_ end of entmake (entmake '((0 . "VERTEX") (10 -5.0 -8.0 0.0) (40 . 2.0) (41 . 0.0) ) ) ;_ end of entmake (entmake '((0 . "VERTEX") (10 -5.0 -9.5 0.0) (40 . 0.0) (41 . 0.0) ) ) ;_ end of entmake (entmake '((0 . "SEQEnd"))) ) ;_ end of defun
|
|