- 积分
- 720
- 明经币
- 个
- 注册时间
- 2010-7-10
- 在线时间
- 小时
- 威望
-
- 金钱
- 个
- 贡献
-
- 激情
-
|
发表于 2012-8-31 14:21:49
|
显示全部楼层
 - ;;----------------------=={ Clock.lsp }==---------------------;;;; ;;;; Program displays a chronograph style clock interface ;;;; powered by a command reactor. ;;;; ;;;; Clock shows analog display, 24H dial, Day of Week Dial, ;;;; Date, Month & Year and Digital display. ;;;; ;;;; ;;;; To Run: ;;;; ------------- ;;;; Type 'Clock' to activate Clock display - clock will ;;;; update when any command is invoked ;;;; ;;;; ;;;; To Disable: ;;;; ------------- ;;;; Type 'Clock' to disable the Clock display. ;;;; ;;;;------------------------------------------------------------;;;; Author: Lee Mac, Copyright ?2010 - www.lee-mac.com ;;;;------------------------------------------------------------;;(defun c:Clock ( / *error* ) (defun *error* ( msg ) (LM:PurgeClock) (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n** Error: " msg " **"))) (princ) ) (setq *layer* "LMAC_Clock" *sH* "LMAC_Second" *mH* "LMAC_Minute" *hH* "LMAC_Hour" *dH* "LMAC_Day" *24H* "LMAC_24H" *font* (if (findfile "C:\\Windows\\Fonts\\Coprgtl.ttf") "Copperplate Gothic Light" "Times New Roman" ) ) ( (lambda ( data foo / react pt ) (if (setq react (vl-some (function (lambda ( reactor ) (if (eq data (vlr-data reactor)) reactor) ) ) (cdar (vlr-reactors :vlr-command-reactor) ) ) ) (if (vlr-added-p react) (progn (vlr-remove react) (LM:PurgeClock) (princ "\nClock Stopped.") ) (vlr-add react) ) (if (setq pt (getpoint "\nPick Insertion Point for Clock: ")) (progn (LM:MakeClock pt) (setq react (vlr-command-reactor data (list (cons :vlr-CommandEnded foo) ) ) ) (princ "\nClock Running.") ) (princ "\n*Cancel*") ) ) react ) "Clock" 'Clock-CallBack ) (princ));;-------------------=={ Clock-CallBack }==-------------------;;;; ;;;; Reactor Callback function to update the relevant items ;;;;------------------------------------------------------------;;;; Author: Lee Mac, Copyright ?2010 - www.lee-mac.com ;;;;------------------------------------------------------------;;;; Arguments: ;;;; reactor - the calling reactor object ;;;; arguments - the arguments supplied by the reactor ;;;;------------------------------------------------------------;;(defun Clock-CallBack ( reactor arguments / date SecDec MinDec 12HDec 24HDec DayDec ss ) (setq date (LM:toDate "HH:MM:SS")) (setq SecDec (/ (atoi (substr date 7 2)) 60.) MinDec (/ (+ (atoi (substr date 4 2)) SecDec) 60.) 12HDec (/ (+ (rem (atoi (substr date 1 2)) 12) MinDec) 12.) 24HDec (/ (+ (atoi (substr date 1 2)) MinDec) 24.) DayDec (/ (fix (rem (getvar 'DATE) 7)) 7.)) (mapcar (function (lambda ( block rotation / ss ) (if (setq ss (ssget "_X" (list (cons 0 "INSERT") (cons 2 block) (cons 8 *layer*)))) (vla-put-rotation (vlax-ename->vla-object (ssname ss 0)) rotation) ) ) ) (list *sH* *mH* *hH* *dH* *24H*) (mapcar '(lambda ( x ) (* x -2. pi)) (list SecDec MinDec 12HDec DayDec 24HDec)) ) (if (setq ss (ssget "_X" (list (cons 0 "MTEXT") (cons 8 *layer*) (cons 1 "*##:##*")))) ( (lambda ( o ) (vla-put-TextString o (strcat "{\\f" *font* "|b0|i0|c0|p34;\\C2;" (LM:toDate "HH:MM") "}") ) ) (vlax-ename->vla-object (ssname ss 0)) ) ) (vla-Regen (vla-get-ActiveDocument (vlax-get-acad-object) ) acActiveViewport ) (princ));;----------------------=={ To Date }==-----------------------;;;; ;;;; Returns a string containing the current date/time in the ;;;; specified format ;;;;------------------------------------------------------------;;;; Author: Lee Mac, Copyright ?2010 - www.lee-mac.com ;;;;------------------------------------------------------------;;;; Arguments: ;;;; format - DIESEL edtime string specifying format ;;;;------------------------------------------------------------;;;; Returns: Date/time string ;;;;------------------------------------------------------------;;(defun LM:toDate ( format ) (menucmd (strcat "m=$(edtime,$(getvar,DATE)," format ")")));;-----------------------=={ Itemp }==------------------------;;;; ;;;; Retrieves the item with index 'item' if present in the ;;;; specified collection, else nil ;;;;------------------------------------------------------------;;;; Author: Lee Mac, Copyright ?2010 - www.lee-mac.com ;;;;------------------------------------------------------------;;;; Arguments: ;;;; coll - the VLA Collection Object ;;;; item - the index of the item to be retrieved ;;;;------------------------------------------------------------;;;; Returns: the VLA Object at the specified index, else nil ;;;;------------------------------------------------------------;;(defun LM:Itemp ( coll item ) (if (not (vl-catch-all-error-p (setq item (vl-catch-all-apply (function vla-item) (list coll item) ) ) ) ) item ));;--------------------=={ Make Clock }==----------------------;;;; ;;;; Creates the Clock Object, including layers and blocks ;;;;------------------------------------------------------------;;;; Author: Lee Mac, Copyright ?2010 - www.lee-mac.com ;;;;------------------------------------------------------------;;;; Arguments: ;;;; p - Insertion Point for the Clock ;;;;------------------------------------------------------------;;(defun LM:MakeClock ( p / LM:LWPoly LM:Insert LM:Circle LM:MText LM:Layer lay date SecDec MinDec 12HDec 24HDec DayDec ) (setq lay *layer* *Fill* (getvar 'FILLMODE)) (setvar 'FILLMODE 1) (defun LM:LWPoly ( pts bul wid cls ) (entmakex (append (list (cons 0 "LWPOLYLINE") (cons 8 lay) (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 90 (length pts)) (cons 70 cls) (cons 43 wid) ) (apply 'append (mapcar '(lambda ( p b ) (list (cons 10 p) (cons 42 b)) ) pts bul ) ) ) ) ) (defun LM:Insert ( pt Nme ro ) (entmakex (list (cons 0 "INSERT") (cons 8 lay) (cons 2 Nme) (cons 10 pt) (cons 50 ro) ) ) ) (defun LM:Circle ( cen rad ) (entmakex (list (cons 0 "CIRCLE") (cons 8 lay) (cons 10 cen) (cons 40 rad) ) ) ) (defun LM:MText ( pt str hg ro ) (entmakex (list (cons 0 "MTEXT") (cons 100 "AcDbEntity") (cons 100 "AcDbMText") (cons 8 lay) (cons 10 pt) (cons 40 hg) (cons 50 ro) (cons 1 str) (cons 71 5) ) ) ) (defun LM:Layer ( Nme Col Plt ) (entmake (list (cons 0 "LAYER") (cons 100 "AcDbSymbolTableRecord") (cons 100 "AcDbLayerTableRecord") (cons 2 Nme) (cons 70 0) (cons 62 Col) (cons 290 Plt) ) ) ) (setq date (LM:toDate "HH:MM:SS")) (setq SecDec (/ (atoi (substr date 7 2)) 60.) MinDec (/ (+ (atoi (substr date 4 2)) SecDec) 60.) 12HDec (/ (+ (rem (atoi (substr date 1 2)) 12) MinDec) 12.) 24HDec (/ (+ (atoi (substr date 1 2)) MinDec) 24.) DayDec (/ (fix (rem (getvar 'DATE) 7)) 7.)) (or (tblsearch "LAYER" lay) (LM:Layer lay 80 0) ) (LM:LWPoly (list (polar p 0 0.09) (polar p pi 0.09)) (list 1. 1.) 0.18 1) (LM:Circle p 0.5) ( (lambda ( i ) (repeat 12 (LM:LWPoly (list (polar p (* (setq i (1+ i)) (/ pi 6.)) 10) (polar p (* i (/ pi 6.)) 8.4) ) '(0. 0.) 0.2 0 ) ) ) -1 ) ( (lambda ( i ) (repeat 60 (LM:LWPoly (list (polar p (* (setq i (1+ i)) (/ pi 30.)) 10.) (polar p (* i (/ pi 30.)) 9.) ) '(0. 0.) 0. 0 ) ) ) -1 ) (mapcar (function (lambda ( a r ) (LM:Circle (polar p a 4.45) r) ) ) (list (/ pi 2.) (/ pi 2.) pi pi) (list 2.5 0.2 2.5 0.2) ) ( (lambda ( i c ) (repeat 7 (LM:LWPoly (list (polar c (+ (/ pi 2.) (* (setq i (1+ i)) (/ (* 2 pi) 7.))) 2.5) (polar c (+ (/ pi 2.) (* i (/ (* 2 pi) 7.))) 2.0) ) '(0. 0.) 0.1 0 ) ) ) -1 (polar p (/ pi 2.) 4.45) ) ( (lambda ( i c ) (repeat 12 (LM:LWPoly (list (polar c (* (setq i (1+ i)) (/ pi 6.)) 2.5) (polar c (* i (/ pi 6.)) 2.0) ) '(0. 0.) 0.1 0 ) ) ) -1 (polar p pi 4.45) ) ( (lambda ( i c ) (repeat 24 (LM:LWPoly (list (polar c (* (setq i (1+ i)) (/ pi 12.)) 2.5) (polar c (* i (/ pi 12.)) 2.15) ) '(0. 0.) 0.0 0 ) ) ) -1 (polar p pi 4.45) ) (LM:LWPoly (list (polar (polar p 0 5.0) (/ (* 3 pi) 2.) 0.9) (polar (polar p 0 7.8) (/ (* 3 pi) 2.) 0.9) (polar (polar p 0 7.8) (/ pi 2.) 0.9) (polar (polar p 0 5.0) (/ pi 2.) 0.9) ) '(0.201387 0.0 0.201387 0.0) 0.0 1 ) (mapcar 'LM:MText (list (polar (polar p 0 5.04) (/ pi 2.) 2.31) (polar p 0 6.4) (polar p (/ (* 3 pi) 2.) 2.50) (polar p (/ (* 3 pi) 2.) 4.15) ) (list (strcat "{\\f"*font*"|b0|i0|c0|p34;\\C2;By Lee Mac}") (strcat "{\\f"*font*"|b0|i0|c0|p34;\\C2;" (LM:toDate "DD") "}") (strcat "{\\f"*font*"|b0|i0|c0|p34;\\C2;" (LM:toDate "HH:MM") "}") (strcat "{\\f"*font*"|b0|i0|c0|p34;\\C2;" (LM:toDate "MONTH YYYY") "}") ) (list 0.5 1.0 1.0 1.0) (list 0. 0. 0. 0.) ) (mapcar (function (lambda ( i c l ) (mapcar (function (lambda ( s ) (LM:MText (polar c (+ (/ pi 2.) (* (setq i (1+ i)) (/ (* 2. pi) (length l)))) 1.65) (strcat "{\\f"*font*"|b0|i0|c0|p34;\\C2;" (car s) "}") 0.3 (cadr s) ) ) ) l ) ) ) '(-1 -1) (list (polar p pi 4.45) (polar p (/ pi 2.) 4.45)) (list (list '("24" 0.) '("18" 0.) '("12" 0.) '("6" 0.)) (list (list "Mon" 0.) (list "Sun" (/ (* 2 pi) 7.)) (list "Sat" (/ (* 4 pi) 7.)) (list "Fri" (/ (* 6 pi) 7.)) (list "Thu" (/ (* 8 pi) 7.)) (list "Wed" (/ (* 10 pi) 7.)) (list "Tue" (/ (* 12 pi) 7.)) ) ) ) (mapcar (function (lambda ( block points width insertion rotation ) (cond ( (tblsearch "BLOCK" block) ) (t (entmakex (list (cons 0 "BLOCK") (cons 10 '(0. 0. 0.)) (cons 2 block) (cons 70 0) ) ) (LM:LWPoly points (mapcar '(lambda ( x ) 0.) points) width 0) (entmakex (list (cons 0 "ENDBLK") (cons 8 "0") ) ) ) ) (LM:Insert insertion block rotation) ) ) (list *sH* *mH* *hH* *dH* *24H*) (list (list '(0.0 0.5) '(0.0 8.0)) (list '(0.0 0.5) '(0.0 8.0)) (list '(0.0 0.5) '(0.0 4.5)) (list '(0.0 0.2) '(0.0 1.3)) (list '(0.0 0.2) '(0.0 1.3)) ) (list 0.0 0.2 0.2 0.1 0.1) (list p p p (polar p (/ pi 2.) 4.45) (polar p pi 4.45)) (mapcar '(lambda ( x ) (* x -2. pi)) (list SecDec MinDec 12HDec DayDec 24HDec)) ) (vla-ZoomWindow (vlax-get-acad-object) (vlax-3D-point (polar p (/ (* 5 pi) 4.) (+ 3. (sqrt 200.)))) (vlax-3D-point (polar p (/ pi 4.) (+ 3. (sqrt 200.)))) ) (vla-Regen (vla-get-ActiveDocument (vlax-get-acad-object) ) acActiveViewport ))(defun LM:PurgeClock ( / doc ss ) (setq doc (vla-get-ActiveDocument (vlax-get-acad-object))) (and *Fill* (setvar 'FILLMODE *Fill*)) (if (and *layer* (setq ss (ssget "_X" (list (cons 8 *layer*))))) ( (lambda ( i / e ) (while (setq e (ssname ss (setq i (1+ i)))) (entdel e)) ) -1 ) ) (mapcar (function (lambda ( sym ) (and sym (tblsearch "BLOCK" sym) (vl-catch-all-apply 'vla-delete (list (LM:Itemp (vla-get-Blocks doc) sym) ) ) ) ) ) (list *sH* *mH* *hH* *dH* *24H*) ) (if (and *layer* (tblsearch "LAYER" *layer*)) (vl-catch-all-apply 'vla-delete (list (LM:Itemp (vla-get-Layers doc) *layer*) ) ) ) (mapcar '(lambda ( sym ) (set sym nil)) '(*sH* *mH* *hH* *dH* *24H* *layer* *Fill* *font*)) (princ))(vl-load-com)(princ "\n:: Clock.lsp | Version 1.0 | ?Lee Mac 2010 www.lee-mac.com ::")(princ "\n:: Type \"Clock\" to Toggle Clock ::")(princ);;------------------------------------------------------------;;;; End of File ;;;;------------------------------------------------------------;;
lee-mac.com 写的反应器版本，使用任意命令结束时时间会更新
|
|
[复制链接]
显身卡
倒是整理下啊，这样看着眼晕！