[转贴]：推荐一个Visual Lisp Date 函数

lsjjm

2. ;;by Bill Kramer for educational purposes only.
   
3. ;; Functions:
   
4. ;;  AcadCalendar    - Given Julian date from AutoCAD DATE variable,
   
5. ;                    returns string MM/DD/YYYY.
   
6. ;  AcadJulianDate  - Determines base value (Midnight) for AutoCAD
   
7. ;                    DATE variable given the month, day, and year.
   
8. ;  AstroCalendar   - Given astronomical Julian date, returns string
   
9. ;                    with MM/DD/YYYY format.
   
10. ;  AstroJulianDate - Given month, day, year returns Julian date as
    
11. ;                    determined by the Naval Astronomical Observatory.
    
12. ;  DayOfWeek       - Given month, day, year returns string with the
    
13. ;                    day of the week.
    
14. ;  DayOfYear       - Given month, day, year return integer number for
    
15. ;                    day of the year.
    
16. ;  isLeapYear      - Given year returns T if leap year, nil otherwise.
    
17. ;; Astronomical Julian Date (number of days since noon, Jan 1, 4713 BC at
    
18. ; Greenwich England),
    
19. ; AutoCAD Julian date is based on the local time plus next Midnight.
    
20. ;; Programs adapted from "Practical Astronomy with your Calculator" by
    
21. ; Peter Duffett-Smith - ISBN 0521356997
    
22. ;;=================================================
    
23. ; AstroJulianDate - given date, calculate Julian Date
    
24. ;   MM - integer Month number
    
25. ;   DD - integer Day number
    
26. ;   YY - integer Year number (complete year as in 2002)
    
27. ;;   Returns real number.
    
28. ;
    
29. (defun AstroJulianDate (MM DD YY / A B C D)
    
30.   (setq B 1)
    
31.   (if (<= YY 1582)
    
32.     (progn ;test for date <10/15/1582
    
33.       (if (< YY 1582) (setq B 0)
    
34.         (if (< MM 10) (setq B 0)
    
35.           (if (< DD 15) (setq B 0))))))
    
36.   ;
    
37.   (if (or (= MM 1) (= MM 2))
    
38.     (setq YY (1- YY)
    
39.           MM (+ MM 12)))
    
40.   (if (= B 1) ;Correction for date > 10/15/1582
    
41.     (setq A (fix (/ YY 100.0))
    
42.           B (+ (- 2.0 A) (fix (/ A 4.0)))))
    
43.   (if (< YY 0)
    
44.     (setq C (fix (- (* YY 365.25) 0.75)))
    
45.     (setq C (fix (* YY 365.25))))
    
46.   (setq D (fix (* 30.6001 (+ MM 1))))
    
47.   (+ B C D DD 1720994.5))
    
48. ;=================================================
    
49. ;
    
50. ; AutoCAD Julian Date - returns base day for ACAD (midnight),
    
51. ; add fraction of day to match "DATE" system variable.
    
52. ;
    
53. ; Parameters same as AstroJulianDate.
    
54. ;
    
55. (defun AcadJulianDate (MM DD YY / T1)
    
56.   (setq T1 (AstroJulianDate MM DD YY)
    
57.         T1 (+ T1 0.5))
    
58. )
    
59. ;=================================================
    
60. ;
    
61. ; AstroCalendar - return string date given Julian date
    
62. ;  JD - real Julian date
    
63. ;
    
64. ;  Returns string of form "MM/DD/YYYY"
    
65. ;
    
66. (defun AstroCalendar (JD / II F A B C D E G TT DD MM YY)
    
67.   (setq II (fix (+ JD 0.5))
    
68.         F (- JD II))
    
69.   (if (> II 2299160.0)
    
70.     (setq A (fix (/ (- II 1867216.25) 35624.25))
    
71.           B (+ II 1 A (fix (/ A -4.0)))
    
72.           )
    
73.     (setq B II)
    
74.     )
    
75.   (setq C (+ B 1524.0)
    
76.         D (fix (/ (- C 122.1) 365.25))
    
77.         E (fix (* D 365.25))
    
78.         G (fix (/ (- C E) 30.6001))
    
79.         TT (+ C (- E) F (fix (* G -30.6001)))
    
80.         DD (fix (+ TT 0.5))
    
81.         )
    
82.   (if (< G 13.5)
    
83.     (setq MM (1- (fix G)))
    
84.     (setq MM (- (fix G) 13))
    
85.     )
    
86.   (if (> MM 2)
    
87.     (setq YY (- (fix D) 4716))
    
88.     (setq YY (- (fix D) 4715)))
    
89.   (strcat (itoa MM) "/" (itoa DD) "/" (itoa YY))
    
90.   )
    
91. ;=================================================
    
92. ;
    
93. ; AcadCalendar - same as AstroCalendar but uses
    
94. ;                offset AutoCAD Julian Date
    
95. ;
    
96. (defun AcadCalendar (aJD)
    
97.   (setq aJD (- (fix aJD) 0.5))
    
98.   (AstroCalendar aJD)
    
99.   )
    
100. ;=================================================
     
101. ;
     
102. ; DayOfWeek - Determine day of week, return string
     
103. ;
     
104. ;  MM - integer month
     
105. ;  DD - integer day
     
106. ;  YY - integer full year
     
107. ;
     
108. (defun DayOfWeek (MM DD YY / T1)
     
109.   (setq T1 (/ (+ (AstroJulianDate MM DD YY) 1.5) 7.0)
     
110.         T1 (fix (+ 0.4 (* 7.0 (- T1 (fix T1))))))
     
111.   (nth T1 '("Sunday"
     
112.             "Monday"
     
113.             "Tuesday"
     
114.             "Wednesday"
     
115.             "Thursday"
     
116.             "Friday"
     
117.             "Saturday"))
     
118. )
     
119. ;=================================================
     
120. ;
     
121. ; DayOfYear - Return integer count of days with
     
122. ;             1 = Jan 1 of year since Jan 1.
     
123. ;
     
124. ;  MM - integer month
     
125. ;  DD - integer day
     
126. ;  YY - integer full year
     
127. ;
     
128. (defun DayOfYear (MM DD YY / iVal tD)
     
129.   (setq iVal (if (isLeapYear YY) 62 63))
     
130.   (if (> MM 2)
     
131.       (setq MM (1+ MM)
     
132.             tD (- (fix (* MM 30.6)) iVal)
     
133.             )
     
134.       (setq MM (1- MM)
     
135.             tD (fix (/ (* MM iVal) 2.0))
     
136.             )
     
137.     )
     
138.   (+ DD tD)
     
139. )
     
140. ;=================================================
     
141. ;
     
142. ; iaLeapYear - Return T if leap year, nil if not a leap year
     
143. ;
     
144. ;  YY - integer full year
     
145. ;
     
146. (defun isLeapYear (YY / TT)
     
147.   (setq TT (/ YY 4.0))
     
148.   (if (equal (- TT (fix TT)) 0.0 0.00001)
     
149.     (progn
     
150.       ;; Divisible by 4, test for 100 year exception
     
151.       (setq TT (/ YY 100.0))
     
152.       (if (equal (- TT (fix TT)) 0.0 0.00001)
     
153.         (progn
     
154.           ;; Divisible by 100, test for 400 year double exception
     
155.           (setq TT (/ YY 400.0))
     
156.           (if (equal (- TT (fix TT)) 0.0 0.00001)
     
157.             T ;divisible by 400 is leap year
     
158.             nil ;divisible by 100 is not leap year
     
159.             )
     
160.           )
     
161.         T ;divisible by 4 but not 100, is leap year
     
162.         )
     
163.       )
     
164.     nil) ;not divisible by 4, not a leap year
     
165. )

;;by Bill Kramer for educational purposes only.<br /> ;; Functions:<br /> ;;  AcadCalendar    - Given Julian date from AutoCAD DATE variable,<br /> ;                    returns string MM/DD/YYYY.<br /> ;  AcadJulianDate  - Determines base value (Midnight) for AutoCAD<br /> ;                    DATE variable given the month, day, and year.<br /> ;  AstroCalendar   - Given astronomical Julian date, returns string<br /> ;                    with MM/DD/YYYY format.<br /> ;  AstroJulianDate - Given month, day, year returns Julian date as<br /> ;                    determined by the Naval Astronomical Observatory.<br /> ;  DayOfWeek       - Given month, day, year returns string with the<br /> ;                    day of the week.<br /> ;  DayOfYear       - Given month, day, year return integer number for<br /> ;                    day of the year.<br /> ;  isLeapYear      - Given year returns T if leap year, nil otherwise.<br /> ;; Astronomical Julian Date (number of days since noon, Jan 1, 4713 BC at<br /> ; Greenwich England),<br /> ; AutoCAD Julian date is based on the local time plus next Midnight.<br /> ;; Programs adapted from "Practical Astronomy with your Calculator" by<br /> ; Peter Duffett-Smith - ISBN 0521356997<br /> ;;=================================================<br /> ; AstroJulianDate - given date, calculate Julian Date<br /> ;   MM - integer Month number<br /> ;   DD - integer Day number<br /> ;   YY - integer Year number (complete year as in 2002)<br /> ;;   Returns real number.<br /> ;<br /> (defun AstroJulianDate (MM DD YY / A B C D)<br />   (setq B 1)<br />   (if (<= YY 1582)<br />     (progn ;test for date <10/15/1582<br />       (if (< YY 1582) (setq B 0)<br />         (if (< MM 10) (setq B 0)<br />           (if (< DD 15) (setq B 0))))))<br />   ;<br />   (if (or (= MM 1) (= MM 2))<br />     (setq YY (1- YY)<br />           MM (+ MM 12)))<br />   (if (= B 1) ;Correction for date > 10/15/1582<br />     (setq A (fix (/ YY 100.0))<br />           B (+ (- 2.0 A) (fix (/ A 4.0)))))<br />   (if (< YY 0)<br />     (setq C (fix (- (* YY 365.25) 0.75)))<br />     (setq C (fix (* YY 365.25))))<br />   (setq D (fix (* 30.6001 (+ MM 1))))<br />   (+ B C D DD 1720994.5))<br /> ;=================================================<br /> ;<br /> ; AutoCAD Julian Date - returns base day for ACAD (midnight),<br /> ; add fraction of day to match "DATE" system variable.<br /> ;<br /> ; Parameters same as AstroJulianDate.<br /> ;<br /> (defun AcadJulianDate (MM DD YY / T1)<br />   (setq T1 (AstroJulianDate MM DD YY)<br />         T1 (+ T1 0.5))<br /> )<br /> ;=================================================<br /> ;<br /> ; AstroCalendar - return string date given Julian date<br /> ;  JD - real Julian date<br /> ;<br /> ;  Returns string of form "MM/DD/YYYY"<br /> ;<br /> (defun AstroCalendar (JD / II F A B C D E G TT DD MM YY)<br />   (setq II (fix (+ JD 0.5))<br />         F (- JD II))<br />   (if (> II 2299160.0)<br />     (setq A (fix (/ (- II 1867216.25) 35624.25))<br />           B (+ II 1 A (fix (/ A -4.0)))<br />           )<br />     (setq B II)<br />     )<br />   (setq C (+ B 1524.0)<br />         D (fix (/ (- C 122.1) 365.25))<br />         E (fix (* D 365.25))<br />         G (fix (/ (- C E) 30.6001))<br />         TT (+ C (- E) F (fix (* G -30.6001)))<br />         DD (fix (+ TT 0.5))<br />         )<br />   (if (< G 13.5)<br />     (setq MM (1- (fix G)))<br />     (setq MM (- (fix G) 13))<br />     )<br />   (if (> MM 2)<br />     (setq YY (- (fix D) 4716))<br />     (setq YY (- (fix D) 4715)))<br />   (strcat (itoa MM) "/" (itoa DD) "/" (itoa YY))<br />   )<br /> ;=================================================<br /> ;<br /> ; AcadCalendar - same as AstroCalendar but uses<br /> ;                offset AutoCAD Julian Date<br /> ;<br /> (defun AcadCalendar (aJD)<br />   (setq aJD (- (fix aJD) 0.5))<br />   (AstroCalendar aJD)<br />   )<br /> ;=================================================<br /> ;<br /> ; DayOfWeek - Determine day of week, return string<br /> ;<br /> ;  MM - integer month<br /> ;  DD - integer day<br /> ;  YY - integer full year<br /> ;<br /> (defun DayOfWeek (MM DD YY / T1)<br />   (setq T1 (/ (+ (AstroJulianDate MM DD YY) 1.5) 7.0)<br />         T1 (fix (+ 0.4 (* 7.0 (- T1 (fix T1))))))<br />   (nth T1 '("Sunday"<br />             "Monday"<br />             "Tuesday"<br />             "Wednesday"<br />             "Thursday"<br />             "Friday"<br />             "Saturday"))<br /> )<br /> ;=================================================<br /> ;<br /> ; DayOfYear - Return integer count of days with<br /> ;             1 = Jan 1 of year since Jan 1.<br /> ;<br /> ;  MM - integer month<br /> ;  DD - integer day<br /> ;  YY - integer full year<br /> ;<br /> (defun DayOfYear (MM DD YY / iVal tD)<br />   (setq iVal (if (isLeapYear YY) 62 63))<br />   (if (> MM 2)<br />       (setq MM (1+ MM)<br />             tD (- (fix (* MM 30.6)) iVal)<br />             )<br />       (setq MM (1- MM)<br />             tD (fix (/ (* MM iVal) 2.0))<br />             )<br />     )<br />   (+ DD tD)<br /> )<br /> ;=================================================<br /> ;<br /> ; iaLeapYear - Return T if leap year, nil if not a leap year<br /> ;<br /> ;  YY - integer full year<br /> ;<br /> (defun isLeapYear (YY / TT)<br />   (setq TT (/ YY 4.0))<br />   (if (equal (- TT (fix TT)) 0.0 0.00001)<br />     (progn<br />       ;; Divisible by 4, test for 100 year exception<br />       (setq TT (/ YY 100.0))<br />       (if (equal (- TT (fix TT)) 0.0 0.00001)<br />         (progn<br />           ;; Divisible by 100, test for 400 year double exception<br />           (setq TT (/ YY 400.0))<br />           (if (equal (- TT (fix TT)) 0.0 0.00001)<br />             T ;divisible by 400 is leap year<br />             nil ;divisible by 100 is not leap year<br />             )<br />           )<br />         T ;divisible by 4 but not 100, is leap year<br />         )<br />       )<br />     nil) ;not divisible by 4, not a leap year<br /> )

li809

有何用处呀