+ Reply to Thread
Results 1 to 9 of 9
  1. #1
    Senior Member
    Using
    AutoCAD 2017
    Join Date
    Oct 2008
    Posts
    230

    Default Lisp calculate current weeknumber

    Registered forum members do not see this ad.

    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 ) 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.

    Code:
    (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?

  2. #2
    Full Member
    Discipline
    Civil
    Aftertouch's Discipline Details
    Discipline
    Civil
    Details
    Engineer
    Using
    AutoCAD 2017
    Join Date
    Jul 2016
    Location
    Netherlands
    Posts
    60

    Default

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

  3. #3
    Senior Member
    Using
    AutoCAD 2017
    Join Date
    Oct 2008
    Posts
    230

    Default

    Quote Originally Posted by Aftertouch View Post
    Ik heb helaas geen oplossing, maar ik vind dit wel een mooie manier om je urenregistratie bij te houden!
    Dat zeker . 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.

  4. #4
    Senior Member
    Using
    not applicable
    Join Date
    Jun 2016
    Posts
    295

    Default

    Here is a suggestion:
    Code:
    ; 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:
    Code:
    ;;; 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.
    ;;;
    ;;; ======================================================================
    BricsCAD 16

  5. #5
    Quantum Mechanic Lee Mac's Avatar
    Computer Details
    Lee Mac's Computer Details
    Operating System:
    Windows 7 Ultimate (32-bit)
    Discipline
    Multi-disciplinary
    Lee Mac's Discipline Details
    Discipline
    Multi-disciplinary
    Details
    Custom Programming / Software Customisation
    Using
    AutoCAD 2013
    Join Date
    Aug 2008
    Location
    London, England
    Posts
    18,962

    Default

    @Roy:
    Code:
    _$ (KGA_Time_Date_To_Week (KGA_Time_CalenderDay_To_DateDay 2010 01 01))
    1
    _$ (KGA_Time_Date_To_Week (KGA_Time_CalenderDay_To_DateDay 2014 12 29))
    53
    Lee Mac ProgrammingTwitterExchange App StoreDropbox (500MB free)

    With Mathematics there is the possibility of perfect rigour, so why settle for less?

  6. #6
    Quantum Mechanic Lee Mac's Avatar
    Computer Details
    Lee Mac's Computer Details
    Operating System:
    Windows 7 Ultimate (32-bit)
    Discipline
    Multi-disciplinary
    Lee Mac's Discipline Details
    Discipline
    Multi-disciplinary
    Details
    Custom Programming / Software Customisation
    Using
    AutoCAD 2013
    Join Date
    Aug 2008
    Location
    London, England
    Posts
    18,962

    Default

    Using this algorithm, I might suggest:
    Code:
    ;; Week Number  -  Lee Mac
    ;; Returns the ISO 8601 week number for a given date
    
    (defun LM:weeknumber ( y m d )
        (   (lambda ( q )
                (cond
                    (   (< q 1) (LM:weeknumber (1- y) 12 28))
                    (   (and (< 28 d) (< 51 q) (< (LM:weeknumber y 12 28) q)) 1)
                    (   q   )
                )
            )
            (/  (+ (nth m '(0 0 31 59 90 120 151 181 212 243 273 304 334))
                   (if (and (LM:leapyear-p y) (< 2 m)) 1 0)
                   (- (LM:weekday y m d)) 9 d
                )
                7
            )
        )
    )
    
    ;; Weekday  -  Lee Mac
    ;; Returns an integer 0-6 (0=Monday;6=Sunday) corresponding to the day of the week for a given date
    ;; Implementation of Zeller's Congruence Algorithm
    
    (defun LM:weekday ( y m d )
        (if (< m 3) (setq y (1- y) m (+ m 12)))
        (rem (+ 5 d (/ (* 26 (1+ m)) 10) y (/ y 4) (* 6 (/ y 100)) (/ y 400)) 7)
    )
    
    ;; LeapYear-p  -  Lee Mac
    ;; Returns T if the supplied year number is a leap year
    
    (defun LM:leapyear-p ( y )
        (and (zerop (rem y 4))
             (or (zerop (rem y 400))
                 (not (zerop (rem y 100)))
             )
        )
    )
    Lee Mac ProgrammingTwitterExchange App StoreDropbox (500MB free)

    With Mathematics there is the possibility of perfect rigour, so why settle for less?

  7. #7
    Senior Member
    Using
    not applicable
    Join Date
    Jun 2016
    Posts
    295

    Default

    Oops, good catch Lee.
    And I should have read https://en.wikipedia.org/wiki/ISO_week_date better.

    Improved code:
    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.
    )
    Last edited by Roy_043; 11th Jan 2017 at 03:58 am.
    BricsCAD 16

  8. #8
    Senior Member
    Using
    not applicable
    Join Date
    Jun 2016
    Posts
    295

    Default

    To verify my last suggestion I have compared my and Lee's offering.
    Result: For the years 1801 - 11800 return values are equal.
    For 1800 and earlier years the (menucmd ...) portion in my code causes wrong return values.
    Code:
    (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)
    )
    Last edited by Roy_043; 11th Jan 2017 at 10:51 am.

  9. #9
    Quantum Mechanic Lee Mac's Avatar
    Computer Details
    Lee Mac's Computer Details
    Operating System:
    Windows 7 Ultimate (32-bit)
    Discipline
    Multi-disciplinary
    Lee Mac's Discipline Details
    Discipline
    Multi-disciplinary
    Details
    Custom Programming / Software Customisation
    Using
    AutoCAD 2013
    Join Date
    Aug 2008
    Location
    London, England
    Posts
    18,962

    Default

    Registered forum members do not see this ad.

    That's reassuring (unless we're both wrong!) - thanks Roy.
    Lee Mac ProgrammingTwitterExchange App StoreDropbox (500MB free)

    With Mathematics there is the possibility of perfect rigour, so why settle for less?

Similar Threads

  1. lisp to calculate mass
    By naserrishehri@yahoo.com in forum AutoLISP, Visual LISP & DCL
    Replies: 22
    Last Post: 22nd Feb 2016, 09:35 am
  2. How can I calculate area by lisp?
    By Rain0923 in forum AutoLISP, Visual LISP & DCL
    Replies: 28
    Last Post: 5th May 2015, 04:30 pm
  3. need lisp to calculate lengths of layers
    By jimpcfd in forum AutoLISP, Visual LISP & DCL
    Replies: 13
    Last Post: 16th Jun 2014, 12:34 pm
  4. lisp to calculate total areas
    By rabeekad in forum AutoLISP, Visual LISP & DCL
    Replies: 6
    Last Post: 5th Nov 2008, 08:49 am
  5. calculate distance between two lines thru lisp
    By vivekgrs in forum AutoLISP, Visual LISP & DCL
    Replies: 1
    Last Post: 19th Jul 2006, 12:18 pm

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts