Julian Dates and more

Read through the entire source file to determine if this example is what you need. At the end of the source listing is a link to a ZIP file for downloading. Permission is granted for you to use this program for what ever purpose you desire. It is provided to you in AS-IS condition and no liability can be assumed by the original author. This function set was created strictly for educational purposes and was not tested under rigorous conditions. You use it, you assume any and all risk. - Good luck and Keep on programmin' - Bill Kramer

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

Download the ZIP file

Return to AutoCAD Programmer examples and articles page