明经CAD社区

 找回密码
 注册

扫一扫,访问微社区

QQ登录

只需一步,快速开始

查看: 2982|回复: 10

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

[复制链接]
发表于 2013-6-2 10:12 | 显示全部楼层 |阅读模式
本帖最后由 VBALISPER 于 2013-6-2 10:15 编辑

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

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有帐号?注册

x

评分

参与人数 1明经币 +1 收起 理由
zctao1966 + 1 赞一个!

查看全部评分

本帖被以下淘专辑推荐:

发表于 2013-6-2 12:08 | 显示全部楼层
我这里也收藏了一个
;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" "" ""))
  ))
发表于 2013-7-20 12:43 | 显示全部楼层
不错,要是在加个数字更好
发表于 2014-11-26 23:15 | 显示全部楼层
感谢楼主@!
发表于 2014-12-12 11:54 | 显示全部楼层
感谢老龙的分享
发表于 2015-1-18 09:31 | 显示全部楼层
太有材了。。。。。。。。。。。。。。
发表于 2015-9-1 16:05 | 显示全部楼层
蛮好玩的,牛
发表于 2016-11-6 00:54 | 显示全部楼层
都 是牛人  
发表于 2017-10-9 11:32 | 显示全部楼层
楼主历害, 我做个双门拉伸动作还没搞明白
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号  
©2000-2017 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2018-10-19 23:54 , Processed in 0.199799 second(s), 35 queries , Gzip On.

Powered by Discuz! X3.3

© 2001-2013 Comsenz Inc.

快速回复 返回顶部 返回列表