会动的数字时钟
;===========================================================;核心的代码不是我的，原来的不会动，我改成会动的，秒针会走，程序正确
;以下小问题没有解决：3、6、9、12四个数字的字高不能随钟表的半径而成比例改变，半径30以下表比较好看
;ERASE 我设成了全部，测试时要建个空白图，图幅以A4为佳
;秒针的走动不太规律，能上网的电脑没有CAD，有小错误大家帮忙改一下，谢谢，程序昨晚能正常运行，
(defun c:YTM22() ;数字时钟
(setq cen (getpoint "\n中心点: "))
(setq rr (* (getdist cen "\n半径: ") 2))
(REPEAT120 ;设了两分钟以供测试
(COMMAND "DELAY" 1000) ;每秒钟重画一次
(setvar "cmdecho" 0)
(setq os (getvar "osmode"))
(setvar "osmode" 0)
(lsp_22a)
(lsp_22b)
(setvar "osmode" os)
(COMMAND "ERASE" "ALL" "") ;把一次画的擦去
)
)
(defun lsp_22a()
(setvar "cecolor" "3")
(command "donut" (/ (* rr 39) 40) rr cen "")
(setvar "cecolor" "1")
(setq pp_12 (polar cen (/ pi 2) (/ rr 2)))
(setq pp_3 (polar cen 0 (/ rr 2)))
(setq pp_6 (polar cen (* pi 1.5) (/ rr 2)))
(setq pp_9 (polar cen pi (/ rr 2)))
(command "donut" 0 (/ rr 12) pp_12 pp_3 pp_6 pp_9 "")
(setvar "cecolor" "7")
(command "pline" cen "w" (/ rr 40) "" cen (polar cen (/ pi 2) (* (/ rr 20) 7)) "")
(setq en3 (entlast))
(setvar "cecolor" "4")
(command "pline" cen "w" (/ rr 50) "" cen (polar cen (/ pi 2) (* (/ rr 20) 8)) "")
(setq en1 (entlast))
(setvar "cecolor" "5")
(command "pline" cen "w" 0 0 cen (polar cen (/ pi 2) (* (/ rr 20) 9)) "")
(setq en2 (entlast))
(setvar "cecolor" "bylayer")
(setq ti (rtos (getvar "cdate") 2 6))
(setq tt (substr ti 10 2))
(setq dd (substr ti 12 2))
(setq mm (substr ti 14 2))
(command "rotate" en3 "" cen (* (atoi tt) -30))
(command "rotate" en2 "" cen (* (atoi mm) -6))
(command "rotate" en1 "" cen (* (atoi dd) -6))
(command "rotate" en3 "" cen (* (atoi mm) -0.5))
)
(defun lsp_22b()
(setq txt_12 (polar pp_12 (* pi 1.5) (/ rr 10)))
(setq txt_3 (polar pp_3 pi (/ rr 10)))
(setq txt_6 (polar pp_6 (/ pi 2) (/ rr 10)))
(setq txt_9 (polar pp_9 0 (/ rr 10)))
(command "text" "m" txt_12 (/ rr 12) 0 "12")
(command "text" "m" txt_3 (/ rr 12) 0 "3")
(command "text" "m" txt_6 (/ rr 12) 0 "6")
(command "text" "m" txt_9 (/ rr 12) 0 "9")
)
;===========================================================
类似的程序如下：
(defun c:lsp_22_1()
(setq os (getvar "osmode"))
(setvar "osmode" 0)
(setq cen (getpoint "\n中心点:"))
(setq rr (* 2 (getdist cen "\n半径:")))
(lsp_22a)
(lsp_22b)
(lsp_22c)
(setvar "osmode" os)
)
;;;;;;;;;;
(defun lsp_22a()
(setvar "cecolor" "3")
(command "donut" (/ (* rr 39) 40) rr cen "")
(setvar "cecolor" "1")
(setq pp_12 (polar cen (/ pi 2) (/ rr 2)))
(setq pp_3 (polar cen 0 (/ rr 2)))
(setq pp_6 (polar cen (* pi 1.5) (/ rr 2)))
(setq pp_9 (polar cen pi (/ rr 2)))
(setvar "cecolor" "7")
(command "pline" cen "w" (/ rr 40) "" cen (polar cen (/ pi 2) (* (/ rr 20) 7)) "")
(setq en3 (entlast))
(setvar "cecolor" "4")
(command "pline" cen "w" (/ rr 50) "" cen (polar cen (/ pi 2) (* (/ rr 20) 8)) "")
(setq en1 (entlast))
(setvar "cecolor" "5")
(command "pline" cen "w" (/ rr 100) "" cen (polar cen (/ pi 2) (* (/ rr 20) 9)) "")
(setq en2 (entlast))
(setvar "cecolor" "bylayer")
(setq ti (rtos (getvar "cdate") 2 6))
(setq tt (substr ti 10 2))
(setq dd (substr ti 12 2))
(setq mm (substr ti 14 2))
(setq nn (substr ti 1 4))
(setq yue (substr ti 5 2))
(setq ri (substr ti 7 2))
(setq ang0_mm (* (atoi mm) -6))
(setq ang0_dd (* (atoi dd) -6))
(setq ang0_tt (* (atoi tt) -30))
(command "rotate" en3 "" cen (* (atoi tt) -30))
(command "rotate" en2 "" cen (* (atoi mm) -6))
(command "rotate" en1 "" cen (* (atoi dd) -6))
(command "rotate" en3 "" cen (* (atoi dd) -0.5))
(setvar "cecolor" "2")
(command "pline" pp_12 "w" (/ rr 100) "" (polar pp_12 (* pi 1.5) (* rr (/ 88.4 1332.9))) "")
(setq en4 (entlast))
(setvar "cecolor" "3")
(command "pline" pp_12 "w" (/ rr 200) "" (polar pp_12 (* pi 1.5) (* rr (/ 68.4 1332.9))) "")
(setq en5 (entlast))
(command "array" en5 "" "p" cen 60 360 "")
(command "array" en4 "" "p" cen 12 360 "")
)
;;;;;;;;;;;
(defun lsp_22b()
(setq txt_12 (polar pp_12 (* 1.5 pi) (/ rr 8)))
(setq txt_3 (polar pp_3 pi (/ rr 8)))
(setq txt_6 (polar pp_6 (/ pi 2) (/ rr 8)))
(setq txt_9 (polar pp_9 0 (/ rr 8)))
(setq txt_t (polar cen (* pi 1.5) (/ rr 4)))
(command "text" "m" txt_12 (/ rr 12) 0 "12")
(command "text" "m" txt_3 (/ rr 12) 0 "3")
(command "text" "m" txt_6 (/ rr 12) 0 "6")
(command "text" "m" txt_9 (/ rr 12) 0 "9")
(setvar "cecolor" "1")
(command "text" "m" txt_t (/ rr 24) 0 (strcat nn "年" " " yue "月" " " ri "日"))
)
;;;;;;;;;;;;;;;;
(defun lsp_22c()
(while en2
(setq ti (rtos (getvar "cdate") 2 8))
(setq nn (substr ti 16 2))
(setq mm_1 (substr ti 14 2))
(setq dd_1 (substr ti 12 2))
(setq tt_1 (substr ti 10 2))
(setq add_mm (- (atoi mm_1) (atoi mm)))
(setq add_dd (- (atoi dd_1) (atoi dd)))
(setq add_tt (- (atoi tt_1) (atoi tt)))
(setq ang1_mm (* (atoi mm_1) -6))
(setq ang1_dd (* (atoi dd_1) -6))
(setq ang1_tt (* (atoi tt_1) -30))
(if (= (atoi nn) 0)
(command "rotate" en2 "" cen (- ang1_mm ang0_mm))
)
(if (= add_dd 1)
(command "rotate" en1 "" cen (- ang1_dd ang0_dd))
)
(if (= add_tt 1)
(command "rotate" en3 "" cen (- ang1_tt ang0_tt))
)
(setq ang0_mm ang1_mm)
(setq ang0_dd ang1_dd)
(setq ang0_tt ang1_tt)
(setq mm mm_1)
(setq dd dd_1)
(setq tt tt_1)
)
)
谢谢楼上的分享
很好。收藏了，留下看看学习学习
谢谢 停不下来。。 秒钟有时会跳到对面去，不过也还可以了 家在湾里 发表于 2011-4-28 10:16 static/image/common/back.gif
秒钟有时会跳到对面去，不过也还可以了
我也不知道为啥走一段时间后秒针就乱跳一下， 回复 革天明 的帖子
对呀！可是我不会改啊 程序都需要强制退出啊 這是"魔法秘笈"中的範例練習題 egos 发表于 2011-4-29 18:33 static/image/common/back.gif
程序都需要强制退出啊
主要在于 repeat 的次数，我设的是两分钟，到时间就停了
页:
[1]
2