用LISP做了个动态时钟,纯属娱乐
本帖最后由 VBALISPER 于 2013-6-2 10:15 编辑练习一下LISP,做了个可以和系统时间一致的动态时钟.
大佬不错 支持下 回帖是一种美德！感谢楼主的无私分享 谢谢 楼主历害, 我做个双门拉伸动作还没搞明白 我这里也收藏了一个
;CAD时钟
;制作： E_God
;邮箱：skzbh1@163.com
;由于CAD没有时间函数，故采用while函数进行循环，故吃程序较占内存；
;部分图形采用command函数生成图形，这是因为CAD没有时间函数，command命令反应较慢，避免程序循环太快，导致卡屏；
;里面有个小bug，每次秒针到35秒时，下面的数显时钟会跳动，由于我是固定文字的坐标，所以可能的原因只跟文字长度有关，
;求各位提出引起原因。
;按ESC建退出，可能会死机
(defun c:shizhong(/)
(setvar "LWDISPLAY" 1)
(command "_zoom" '(-25 -25 0) '(225 225 0))
(setq c3 '(60 130 0))
(setq date0(menucmd "M=$(edtime,$(getvar,date),yyyy/M/DD)"))
(entmake (list '(0 . "TEXT") (cons 1 date0) (cons 10 c3) (cons 40 10)'(62 . 1)))
(tx)
(time1)
)
(Princ "\nCAD时钟加载成功，运行命令shizhong，按任意键终止")
(princ)
;;;时钟指针
(defun time1 (/)
(setq c1 '(100 100 0))
(setq c2 '(75 50 0))
(setq r1 100)
(setq datess (atoi (menucmd "M=$(edtime,$(getvar,date),ss)")))
(setq datemm (atoi (menucmd "M=$(edtime,$(getvar,date),mm)")))
(setq datehh (atoi (menucmd "M=$(edtime,$(getvar,date),hh)")))
(setq op1 (- (* pi 0.5) (* (/ pi 30) datess)))
(setq pe1 (polar c1 op1 (- r1 10)))
(entmake (list '(0 . "LINE")
(cons 10 c1)
(cons 11 pe1)
'(8 . "时钟层3")
'(62 . 2)
)
)
(setq sz (entlast))
(setq datemm (atoi (menucmd "M=$(edtime,$(getvar,date),mm)")))
(setq op2 (- (* pi 0.5) (* (/ pi 30) datemm)))
(setq pe2 (polar c1 op2 (- r1 30)))
(entmake (list '(0 . "LINE")
(cons 10 c1)
(cons 11 pe2)
'(8 . "时钟层2")
'(62 . 2)
)
)
(setq mz (entlast))
(setq datehh (atoi (menucmd "M=$(edtime,$(getvar,date),hh)")))
(setq op3 (- (* pi 0.5) (* (/ pi 6) datehh)))
(setq pe3 (polar c1 op3 (- r1 50)))
(entmake (list '(0 . "LINE")
(cons 10 c1)
(cons 11 pe3)
'(8 . "时钟层1")
'(62 . 3)
)
)
(setq hz (entlast))
(entmake (list '(0 . "CIRCLE")
(cons 10 c1)
(cons 40 10)
'(8 . "时钟层3")
'(62 . 0)
)
)
(setq cc (entlast))
(setq tt T)
(while tt
(progn (setq datess1 (atoi (menucmd "M=$(edtime,$(getvar,date),ss)")))
(setq datemm1 (atoi (menucmd "M=$(edtime,$(getvar,date),mm)")))
(setq datehh1 (atoi (menucmd "M=$(edtime,$(getvar,date),hh)")))
(if (/= datehh1 datehh)
(progn
(setq datehh datehh1)
(setq
op3 (- (* pi 0.5) (* (/ pi 6) datehh))
)
(setq pe3 (polar c1 op3 (- r1 50)))
(setq ed3 (entget hz))
(setq ed3 (subst (cons 11 pe3)
(assoc 11 ed3)
ed3
)
)
(entmod ed3)
)
)
(if (/= datemm1 datemm)
(progn
(setq datemm datemm1)
(setq
op2 (- (* pi 0.5) (* (/ pi 30) datemm))
)
(setq pe2 (polar c1 op2 (- r1 30)))
(setq ed2 (entget mz))
(setq ed2 (subst (cons 11 pe2)
(assoc 11 ed2)
ed2
)
)
(entmod ed2)
)
)
(if (/= datess1 datess)
(progn
(setq datess datess1)
(setq
op1 (- (* pi 0.5) (* (/ pi 30) datess))
)
(setq pe1 (polar c1 op1 (- r1 10)))
(setq ed1 (entget sz))
(setq ed1 (subst (cons 11 pe1)
(assoc 11 ed1)
ed1
)
)
(entmod ed1)
(setq ed4 (entget cc))
(setq ed4 (subst (cons 62 datess1)
(assoc 62 ed4)
ed4
)
)
(entmod ed4)
(setq datehms (menucmd "M=$(edtime,$(getvar,date),hh:mm:ss)"))
(command "erase" datehmsname "")
(command "text" c2 "10" "0" datehms)
(setq datehmsname (entlast))
(setq gd (grread t 4 0))
(setq mode (car gd))
(if (= mode 2)
(setq tt nil)
T
)
(command "_.zoom" "w" '(-25 -25 0) '(225 225 0))
)
)
)
)
)
;;;画出时钟外轮廓
(defun tx(/)
(Nlayer)
(setq c1 '(100 100 0))
(setq r1 100)
(setq r2 (- r1 2))
(setq r3 (- r1 3))
(setq r4 (- r1 10))
(setq n 0)
(setq i 0)
(entmake (list '(0 . "CIRCLE") (cons 10 c1) (cons 40 r1)'(8 . "时钟层1")))
(entmake (list '(0 . "CIRCLE") (cons 10 c1) (cons 40 r2)'(8 . "时钟层2")))
(entmake (list '(0 . "CIRCLE") (cons 10 c1) (cons 40 r3)'(8 . "时钟层3")))
(while (< n 60)
(setq op (* i (/ pi 30)))
(if (= (rem i 5) 0)
(progn (setq pt1 (polar c1op r4) )
(setq pt2 (polar c1op r3))
(setq pt3 (polar c1 op (- r4 4)))
(setq pt3x (- (car pt3)3))
(setq pt3y (- (cadr pt3) 4))
(setq pt3 (list pt3x pt3y 0))
(setq tex (nth (/ i 5) '("3" "2" "1" "12" "11" "10" "9" "8" "7" "6" "5" "4")))
(entmake (list '(0 . "LINE") (cons 10 pt1) (cons 11 pt2)'(8 . "时钟层2")'(62 . 71)))
(entmake (list '(0 . "TEXT") (cons 1 tex) (cons 10 pt3) (cons 40 8)))
)
(progn(setq pt1 (polar c1op (+ r4 2)) )
(setq pt2 (polar c1op (- r3 1)))
(entmake (list '(0 . "LINE") (cons 10 pt1) (cons 11 pt2)'(8 . "时钟层3")))
)
)
(setq i (+ i 1))
(setq n (+ n 1))
)
)
;新建图层
(defun Nlayer (/)
(if (not (tblsearch "layer" "时钟层1"))
(progn(entmake '((0 . "LAYER")
(100 . "AcDbSymbolTableRecord")
(100 . "AcDbLayerTableRecord")
(2 . "时钟层1")
(70 . 0)
(62 . 2)
(6 . "Continuous")
)
)
(command "layer" "m" "时钟层1" "lw" "0.6" "" ""))
)
(if (not (tblsearch "layer" "时钟层2"))
(progn(entmake '((0 . "LAYER")
(100 . "AcDbSymbolTableRecord")
(100 . "AcDbLayerTableRecord")
(2 . "时钟层2")
(70 . 0)
(62 . 6)
(6 . "Continuous")
)
)
(command "layer" "m" "时钟层2" "lw" "0.3" "" ""))
)
(if (not (tblsearch "layer" "时钟层3"))
(progn(entmake '((0 . "LAYER")
(100 . "AcDbSymbolTableRecord")
(100 . "AcDbLayerTableRecord")
(2 . "时钟层3")
(70 . 0)
(62 . 4)
(6 . "Continuous")
)
)
(command "layer" "m" "时钟层3" "lw" "0.2" "" ""))
)) 不错，要是在加个数字更好 感谢楼主@！ 感谢老龙的分享 太有材了。。。。。。。。。。。。。。 蛮好玩的，牛 都 是牛人 {:1_1:}{:1_1:}{:1_1:}有才
页:
[1]
2