;;-----------------------------------------------
;; CADENCE - Programmer's Toolbox  March 1996
;; Bill Kramer
;;
;;----------------------------------------------- Listing 1
;; Today  creates a string with today's date
;; in it.
;;
(defun Today ( / TMP)
  (setq TMP (rtos (getvar "CDATE") 2 0))
  (strcat
     (substr TMP 5 2)
     "/"
     (substr TMP 7 2)
     "/"
     (substr TMP 1 4)
  )
)
;;----------------------------------------------- Listing 2
;; Make_Date  converts list of three numbers into
;; date format based on code type.
;;   Code = 0   MM/DD/YY
;;          1   Mon. DD, YY
;;          2   Month DD, YY
;;
(defun Make_Date (Date_List Code / Month_Names)
   (Set_Months) ;;build Month_Names list
   (if (and
         Date_List
         (= (length Date_List) 3)
         (apply 'and (mapcar 'numberp Date_list))
         (<= 1 (car Date_List) 12) ;;month range
         (<= 1 (cadr Date_List) 31) ;;day range
       )
     (cond
      ((= Code 0)
        (strcat
          (itoa (car Date_List))
          "/"
          (itoa (cadr Date_List))
          "/"
          (itoa (caddr Date_List))
        )
      )
      ((= Code 1)
        (strcat
          (cadr 
            (nth (1- (car Date_List)) 
                 Month_Names))
          ". "
          (itoa (cadr Date_List))
          ", "
          (itoa (caddr Date_List))
        )
      )
      ((= Code 2)
        (strcat
          (car 
            (nth (1- (car Date_List)) 
                 Month_Names))
          " "
          (itoa (cadr Date_List))
          ", "
          (itoa (caddr Date_List))
        )
      )
     ) ;;end COND
     ;;else, Date_List is invalid!
     (prompt "\nBad date list in MAKE_DATE")
   ) ;;end IF test for Date_List
)
;;-----------------------------------------------
;; Establishes the values of list containing the
;; names of the months along with the standard
;; abreviations.  This function can be modified
;; for local languages.
;;
(defun Set_Months ()
  (setq Month_Names   
         '(( "January"     "Jan")
           ( "February"    "Feb")
           ( "March"       "Mar")
           ( "April"       "Apr")
           ( "May"         "May")
           ( "June"        "Jun")
           ( "July"        "Jul")
           ( "August"      "Aug")
           ( "September"   "Sep")
           ( "October"     "Oct")
           ( "November"    "Nov")
           ( "December"    "Dec")
         )
  )
)
;;----------------------------------------------- Listing 3
;; Is_A_Date  check string to see if it a date
;; Checks for the following date formats:
;;   ##/##/##                 MM/DD/YY
;;   ##/##/####               MM/DD/YYYY
;;   sss. ##, ####            Mon. DD, YYYY
;;   ssss...sss ##, ####      Month DD, YYYY
;;
(defun Is_A_Date (S / Month_Names TMP Mon)
  (Set_Months) ;;build Month_Names list
  (setq Month_Names  ;;convert to upper case
    (mapcar 
      '(lambda (TMP)
         (mapcar 'strcase TMP))
      Month_Names)
  )
  (cond
    ((wcmatch S "##/##/*,##/#/*,#/##/*,#/#/*") 
       (numb_parse S)
    )
    ((wcmatch S "##-##-*,#-##-*,##-#-*,#-#-*")
       (numb_parse (subst_str S "/" "-")))
    ;; Check for short version of name in list
    ((member (strcase (substr S 1 3))
             (mapcar 'cadr Month_Names))
       (setq TMP (numb_parse (substr S 4)))
       (list
         (- 13
            (length 
              (member 
                 (strcase (substr S 1 3)) 
                 (mapcar 'cadr Month_Names))))
         (car TMP)
         (cadr TMP)
       )
    )
    (t ;;isolate potential month name
       (setq Mon "")
       (while (and (> (strlen S) 0) 
                   (/= (substr S 1 1) " "))
          (setq Mon (strcat Mon (substr S 1 1))
                S (substr S 2)
          )
       )
       ;;see if in month names list
       (if (member (strcase Mon) 
                   (mapcar 'car Month_Names))
          (setq TMP 
           (cons
             (- 13 ;;relative month number
               (length ;;calculation
                 (member 
                   (strcase Mon) 
                   (mapcar 'car Month_Names))))
             (numb_parse S) ;;remaining is day/yr
           )
          )
       )
       (if (and TMP 
                (= (length TMP) 3)
                (numberp (car TMP))
                (numberp (cadr TMP))
                (numberp (caddr TMP))
           )
         TMP ;;return TMP list
       )    ;;else return nil if not a date str.
    )
  )
)
;;----------------------------------------------- Listing 4
;; Number parsing - returns list of numbers
;; parsed from the input string S.
;; Example:
;;  (NUMB_PARSE "1,2.5,3.1415") returns
;;  the list (1 2.5 3.1415)
;;
(defun Numb_Parse (S / RET TMP CH Digs Trigs)
   (setq Digs 
      '( "." "0" "1" "2" "3" "4" "5" 
         "6" "7" "8" "9" "-")
         Trigs
      '( " " "," "/")
         TMP ""
   )
   (while (> (strlen S) 0)
      (setq CH (substr S 1 1)
            S (substr S 2)
      )
      (if (and (> (strlen TMP) 0)
               (member CH Trigs))
         (setq RET (cons (read TMP) RET)
               TMP ""
         )
      )
      (if (> (strlen TMP) 0)
         (if (member CH Digs)
            (setq TMP (strcat TMP CH)))
         (if (member CH (cdr Digs))
            (setq TMP (strcat TMP CH)))
      )
   )
   (if (> (strlen TMP) 0)
      (setq RET (cons (read TMP) RET))
   )
   (reverse RET)
)
;;----------------------------------------------- Listing 5
;; SUBST_STR  substitute string
;; Changes all occurances of OLD in S with the
;; string NEW.  All arguments to function are
;; strings.
;;
(defun SUBST_STR (S New Old / Ret II JJ)
   (setq Ret ""
         II (strlen New)
         JJ (strlen Old)
   )
   (while (> (strlen S) 0)
     (if (= (substr S 1 JJ) Old)
         (setq RET (strcat RET New)
               S (substr S (1+ JJ))
         )
         (setq RET (strcat RET (substr S 1 1))
               S (substr S 2)
         )
     )
   )
   RET
)
;;----------------------------------------------- Listing 6
;; Change all date strings stored as Text or
;; Attributes found in the current drawing
;; to be the current date.  Operator can choose
;; date format from supported list of options.
;;
(defun C:TODAY ( / SS1 SS2 Dt CNT EL TMP Tx)
  (setq Dt (Is_A_Date (Today)) ;;today's date str
        SS1 (ssget ;;regular text location
              "X" 
              '((0 . "TEXT")))
        SS2 (ssget ;;inserts with attributes
              "X" 
              '((0 . "INSERT") (66 . 1)))
        CNT (if SS2 (sslength SS2) 0)
  )
  ;;add ATTRIB entities to SS1, if any found
  (while (> CNT 0)
    (setq CNT (1- CNT)
          EL (entget (entnext (ssname SS2 CNT)))
    )
    (while (= (cdr (assoc 0 EL)) "ATTRIB")
      (ssadd (cdr (assoc -1 EL)) SS1)
      (setq EL (entget (entnext (cdr (assoc -1 EL)))))
    )
  )
  (setq CNT (sslength SS1))
  (prompt (strcat 
     " " (itoa CNT) " entities found of interest."
     "\nDate format: <0="
     (Make_Date Dt 0)
     ">  1="
     (Make_Date Dt 1)
     "  2="
     (Make_Date Dt 2)
     ": "
  ))
  (setq TMP (getint))
  (if (or (null TMP) (< TMP 0) (> TMP 2)) 
     (setq TMP 0))
  (setq Dt (Make_Date Dt TMP))
  ;;
  ;;search SS1 for date strings
  (while (> CNT 0)
     (setq CNT (1- CNT)
           EL (entget (ssname SS1 CNT))
           Tx (cdr (assoc 1 EL))
     )
     (if (Is_A_Date Tx)
       (entmod
         (subst
           (cons 1 Dt)
           (assoc 1 EL)
           EL)))
  )
  (if SS2 (command "_REGEN"))
  (princ)
)
;;----------------------------------------------- EOF