Jump to content

Lisp calculate current weeknumber


OMEGA-ThundeR

Recommended Posts

Hi,

 

I use various lisp to get to certain company based files i need to fill out. Since AutoCAD runs pretty much all day it's a quick way to open the files i need.

 

We use excel files to elaborate on the time we spend on projects, these are based on the current year and week. So every week we start a new file for administration.

 

So far the inside information, here's my question:

 

In the following lisp i made (perhaps not the most effective way, but it works for me :P) i call the command with 'UREN' (it's Dutch) and i need to add a year and weeknumber. After that it opens the correct file.

 

Adding the weeknumber is pretty much the only thing i have to do, but i would like to know if it is possible to let the lisproutine add the current week automaticly.

 

(defun c:uren( / Excel NetwerkMap Jaar Wie DubbelSlash NetwerkLocatie UrenWeek WeekCheck Week Bestandsnaam NetwerkDeellocatie)

; STANDAARD NETWERKLOCATIE
;(setq Excel "C:\\Program Files (x86)\\Microsoft Office\\root\\Office16\\EXCEL.EXE")
(setq NetwerkMap "L:\\Admin\\Urenstaten\\")
(setq Jaar (getstring "\nUren van welk jaar? <2017>: "))
; ALS JAAR NIET IS INGEVULD DAN VULLEN WE STANDAARD 2017 IN
(if (/= Jaar "")
	() ; ALS JAAR IS INGEVULD DAN DOEN WE DAAR NIKS MEE
	(setq Jaar "2017")
)
; ALS WIE NIET IS INGEVULD DAN VULLEN WE STANDAARD STORM IN
(if (/= Wie "")
	() ; ALS WIE IS INGEVULD DAN DOEN WE DAAR NIKS MEE
	(setq Wie "Storm")
)
(setq DubbelSlash "\\")
(setq NetwerkLocatie (strcat NetwerkMap Jaar DubbelSlash))

; INPUT WEEKNUMMER
(if (setq UrenWeek (getstring "\nUren van welke week: "))
 		; CONTROLE OP GELDIGHEID
	(if (or (/= (strlen UrenWeek) 2)
         	(wcmatch UrenWeek "*`.*"))
  		; VOORWAARDE - ONWAAR
	(ACET-UI-MESSAGE "Het weeknummer moet 2 cijfers bevatten"
                             "Verkeerd weeknummer"
                             (+ Acet:OK Acet:ICONINFORMATION)
	)
	; VOORWAARDE - WAAR
		(progn	
			; BEPALEN DISCIPLINE
			(setq WeekCheck (substr UrenWeek 1 2))
		  	(cond
			((= WeekCheck "00") (setq Week " - 00\\"))
			((= WeekCheck "01") (setq Week " - 01\\"))
			
			; You get the idea..

			((= WeekCheck "52") (setq Week " - 52\\"))
			((= WeekCheck "53") (setq Week " - 53\\"))

			)
			;(setq Bestandsnaam (strcat Jaar "-" WeekCheck "_" Wie ".xlsm"))		
			(setq NetwerkDeellocatie (strcat NetwerkLocatie Jaar Week))
			;(startapp Excel NetwerkDeellocatie Bestandsnaam)
			
			; CONTROLEER OF WEEKNUMMER AL BESTAAT OF NIET
			(if (vl-file-directory-p NetwerkDeellocatie)
				(startapp "EXPLORER" (strcat NetwerkDeellocatie))
				(ACET-UI-MESSAGE (strcat "Weeknummer " WeekCheck " is (nog) niet aangemaakt of bestaat nog niet voor het jaar " Jaar "!")
					"Map bestaat niet"
					(+ Acet:OK Acet:ICONINFORMATION)
				)
			)			
		)
 		)
	)
(princ)
)

 

Is it possible?

Link to comment
Share on other sites

Ik heb helaas geen oplossing, maar ik vind dit wel een mooie manier om je urenregistratie bij te houden!

 

Dat zeker :P. Ook gezien Excel niet echt lekker werkt met een snelkoppeling in de startbalk. En gewoon een commando draaien onder AutoCAD om gelijk naar het goede bestand te gaan maakt het wel zo makkelijk.

Link to comment
Share on other sites

Here is a suggestion:

; See: Julian Day Number theory.
(defun KGA_Time_CalenderDay_To_DateDay (year month day / a m y)
 (setq a (/ (- 14 (fix month)) 12))
 (setq y (+ (fix year) 4800 (- a)))
 (setq m (+ (fix month) (* 12 a) -3))
 (+ (fix day) (/ (+ (* 153 m) 2) 5) (* 365 y) (/ y 4) (/ y -100) (/ y 400) -32045)
)

; (KGA_Time_Date_To_Week (getvar 'date))
; (KGA_Time_Date_To_Week (KGA_Time_CalenderDay_To_DateDay 2017 2 27))
(defun KGA_Time_Date_To_Week (date / mondayWeek1 week1)
 ;; January 4 is always in week 1 (https://en.wikipedia.org/wiki/ISO_week_date):
 (setq week1
   (KGA_Time_CalenderDay_To_DateDay
     (read (menucmd (strcat "m=$(edtime," (itoa (setq date (fix date))) ",yyyy)"))) 
     1 
     4
   )
 )
 (setq mondayWeek1
   (-
     week1
     (cdr
       (assoc
         (read (menucmd (strcat "m=$(edtime," (itoa week1) ",ddd)")))
         '((mon . 0) (tue . 1) (wed . 2) (thu . 3) (fri . 4) (sat . 5) (sun . 6))
       )
     )
   )
 )
 (1+ (/ (- date mondayWeek1) 7))
)

Julian Day Number theory:

;;; Links:
;;; http://en.wikipedia.org/wiki/Julian_day
;;; http://www.fourmilab.ch/documents/calendar/

;;; ======================================================================
;;; Julian Day Number theory:
;;;
;;; http://www.cs.utsa.edu/~cs1063/projects/Spring2011/Project1/jdn-explanation.html
;;;
;;; This web page provides a brief explanation for how the Julian Day
;;; Number (JDN) is calculated in Project 1.
;;;
;;; The expression for a:
;;;   a = (14 - month)/12
;;;
;;; will result in a 1 for January (month 1) and February (month 2). The
;;; result is 0 for the other 10 months.
;;;
;;; The expression for y:
;;;   y = year + 4800 - a
;;;
;;; adds 4800 to the year so that we will start counting years from the
;;; year –4800. [As a side note, year 1 corresponds to 1 CE, year 0
;;; corresponds to 1 BCE, year –1 corresponds to 2 BCE, and so on. There
;;; is no year between 1 CE and 1 BCE.]
;;;
;;; The - a part of the expression subtracts one if the month is January
;;; or February and goes along with the next part of the calculation.
;;;
;;; The expression for m:
;;;   m = month + 12a - 3
;;;
;;; results in a 10 for January, 11 for February, 0 for March, 1 for
;;; April, ..., and a 9 for December. This is because a is 1 for January
;;; and February and 0 for the other months. The effect of the combined
;;; calculation of y and m is to pretend that the year begins in March
;;; and ends in February.
;;;
;;; The expression for JDN:
;;;   JDN = day + (153m + 2)/5 + 365y + y/4 - y/100 + y/400 - 32045
;;;
;;; has several parts to it. Remember that we are calculating the number
;;; of days since a fixed day in the past, and there are several things
;;; to take into account.
;;;
;;;   - Adding day (the day of the month) should be easy to figure out.
;;;     Each increment to day increments the number of days since a fixed
;;;     day.
;;;
;;;   - The integer division (153m + 2)/5 is a cleverly designed
;;;     expression to calculate the number of days in the previous months
;;;     (where March corresponds to m=0). So for example, June corresponds
;;;     to a value of 3 for m. For this value of m,  the expression
;;;     results in a value of 461/5 = 92 using integer division, which are
;;;     the total number of days in March, April, and May.
;;;
;;;   - The expression 365y should be easy to figure out, i.e., each
;;;     non-leap-year has 365 days.
;;;
;;;   - The expression y/4 - y/100 + y/400 (all integer divisions)
;;;     calculates the number of leap years since the year –4800 (which
;;;     corresponds to a value of 0 for y).  Recall that there is a leap
;;;     year every year that is divisible by 4, except for years that are
;;;     divisible by 100, but not divisible by 400.  The number of leap
;;;     years is, of course, the same as the number of leap days that need
;;;     to be added in.
;;;
;;;   - The last part - 32045 ensures that the result will be 0 for
;;;     January 1, 4713 BCE.
;;;
;;; ======================================================================

Link to comment
Share on other sites

Using this algorithm, I might suggest:

[color=GREEN];; Week Number  -  Lee Mac[/color]
[color=GREEN];; Returns the ISO 8601 week number for a given date[/color]

([color=BLUE]defun[/color] LM:weeknumber ( y m d )
   (   ([color=BLUE]lambda[/color] ( q )
           ([color=BLUE]cond[/color]
               (   ([color=BLUE]<[/color] q 1) (LM:weeknumber ([color=BLUE]1-[/color] y) 12 28))
               (   ([color=BLUE]and[/color] ([color=BLUE]<[/color] 28 d) ([color=BLUE]<[/color] 51 q) ([color=BLUE]<[/color] (LM:weeknumber y 12 28) q)) 1)
               (   q   )
           )
       )
       ([color=BLUE]/[/color]  ([color=BLUE]+[/color] ([color=BLUE]nth[/color] m '(0 0 31 59 90 120 151 181 212 243 273 304 334))
              ([color=BLUE]if[/color] ([color=BLUE]and[/color] (LM:leapyear-p y) ([color=BLUE]<[/color] 2 m)) 1 0)
              ([color=BLUE]-[/color] (LM:weekday y m d)) 9 d
           )
           7
       )
   )
)

[color=GREEN];; Weekday  -  Lee Mac[/color]
[color=GREEN];; Returns an integer 0-6 (0=Monday;6=Sunday) corresponding to the day of the week for a given date[/color]
[color=GREEN];; Implementation of Zeller's Congruence Algorithm[/color]

([color=BLUE]defun[/color] LM:weekday ( y m d )
   ([color=BLUE]if[/color] ([color=BLUE]<[/color] m 3) ([color=BLUE]setq[/color] y ([color=BLUE]1-[/color] y) m ([color=BLUE]+[/color] m 12)))
   ([color=BLUE]rem[/color] ([color=BLUE]+[/color] 5 d ([color=BLUE]/[/color] ([color=BLUE]*[/color] 26 ([color=BLUE]1+[/color] m)) 10) y ([color=BLUE]/[/color] y 4) ([color=BLUE]*[/color] 6 ([color=BLUE]/[/color] y 100)) ([color=BLUE]/[/color] y 400)) 7)
)

[color=GREEN];; LeapYear-p  -  Lee Mac[/color]
[color=GREEN];; Returns T if the supplied year number is a leap year[/color]

([color=BLUE]defun[/color] LM:leapyear-p ( y )
   ([color=BLUE]and[/color] ([color=BLUE]zerop[/color] ([color=BLUE]rem[/color] y 4))
        ([color=BLUE]or[/color] ([color=BLUE]zerop[/color] ([color=BLUE]rem[/color] y 400))
            ([color=BLUE]not[/color] ([color=BLUE]zerop[/color] ([color=BLUE]rem[/color] y 100)))
        )
   )
)

Link to comment
Share on other sites

Oops, good catch Lee.

And I should have read https://en.wikipedia.org/wiki/ISO_week_date better. :oops:

 

Improved code:

(defun KGA_Time_CalenderDay_To_DateDay (year month day / a m y)
 (setq a (/ (- 14 (fix month)) 12))
 (setq y (+ (fix year) 4800 (- a)))
 (setq m (+ (fix month) (* 12 a) -3))
 (+ (fix day) (/ (+ (* 153 m) 2) 5) (* 365 y) (/ y 4) (/ y -100) (/ y 400) -32045)
)

; https://weeknumber.net/how-to/javascript
; https://en.wikipedia.org/wiki/ISO_week_date
; (KGA_Time_Date_To_Week (getvar 'date))
; (KGA_Time_Date_To_Week (KGA_Time_CalenderDay_To_DateDay 2010 01 01)) => 53
; (KGA_Time_Date_To_Week (KGA_Time_CalenderDay_To_DateDay 2014 12 29)) => 1
(defun KGA_Time_Date_To_Week (date / week1)
 ;; Thursday in current week decides the year:
 (setq date (fix date))
 (setq date (+ date 3 (- (rem (+ (rem (1+ date) 7) 6) 7)))) ; (rem (1+ date) 7) => Day of the week (0 = Sunday).
 ;; January 4 is always in week 1:
 (setq week1
   (KGA_Time_CalenderDay_To_DateDay
     (read (menucmd (strcat "m=$(edtime," (itoa date) ",yyyy)")))
     1
     4
   )
 )
 (fix (+ 1.5 (/ (- date week1) 7.0))) ; No need to calculate Thursday in week 1.
)

Edited by Roy_043
Link to comment
Share on other sites

To verify my last suggestion I have compared my and Lee's offering.

Result: For the years 1801 - 11800 return values are equal. :D

For 1800 and earlier years the (menucmd ...) portion in my code causes wrong return values.

(defun c:Test ( / errorLst year lst month)
 (setq year 1800)
 (setq lst
   '(
     ( 1 ( 1  2  3  4  5  6  7))
     (12 (25 26 27 28 29 30 31))
   )
 )
 (repeat 10000
   (setq year (1+ year))
   (foreach sub lst
     (setq month (car sub))
     (foreach day (cadr sub)
       (if
         (/= 
           (KGA_Time_Date_To_Week (KGA_Time_CalenderDay_To_DateDay year month day))
           (LM:weeknumber year month day)
         )
         (setq errorLst (cons (list year month day) errorLst))
       )
     )
   )
 )
 (if errorLst
   (progn 
     (princ "\nFor these dates return values are different: ")
     (print errorLst)
   )
   (princ "\nAll return values are equal ")
 )
 (princ)
)

Edited by Roy_043
Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...