用LISP做了个动态时钟,纯属娱乐

VBALISPER · 发表于 2013-6-2 10:12:20

本帖最后由 VBALISPER 于 2013-6-2 10:15 编辑

练习一下LISP,做了个可以和系统时间一致的动态时钟.

1028882406@qq.c · 发表于 2022-5-1 23:20:53

大佬不错支持下

pengfei2010 · 发表于 2017-10-9 17:52:59

回帖是一种美德！感谢楼主的无私分享谢谢

ccc230 · 发表于 2017-10-9 11:32:09

楼主历害, 我做个双门拉伸动作还没搞明白

669423907 · 发表于 2013-6-2 12:08:10

我这里也收藏了一个
;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 c1  op r4) )
(setq pt2 (polar c1  op 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 c1  op (+ r4 2)) )
(setq pt2 (polar c1  op (- 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" "" ""))
  ))

jyzas · 发表于 2013-7-20 12:43:48

不错，要是在加个数字更好

看天的小树 · 发表于 2014-11-26 23:15:32

感谢楼主@！

ynhh · 发表于 2014-12-12 11:54:28

感谢老龙的分享

此站网友 · 发表于 2015-1-18 09:31:32

太有材了。。。。。。。。。。。。。。

xyz002 · 发表于 2015-9-1 16:05:30

蛮好玩的，牛

我爱茶0917 · 发表于 2016-11-6 00:54:05

都是牛人

13820172395 · 发表于 2017-8-2 10:53:12

有才

账号		自动登录	找回密码
密码			注册

用LISP做了个动态时钟,纯属娱乐

本帖子中包含更多资源

评分

本帖被以下淘专辑推荐:

相关帖子