;; Listing 1
;;
(defun C:Y2K ( / SS1 SS2 Dt CNT EL TMP Tx)
  (setq SS1 (ssget ;;regular text location
              "X" 
              '((0 . "TEXT") ))
        SS2 (ssget ;;inserts with attributes
              "X" 
              '((0 . "INSERT") (66 . 1)))
        CNT (if SS2 (sslength SS2) 0)
  )
  (if (null SS1) (setq SS1 (ssadd)))
  ;;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 to scan."
  ))
  ;;
  ;;search SS1 for date strings
  (while (> CNT 0)
     (setq CNT (1- CNT)
           EL (entget (ssname SS1 CNT))
           Tx (cdr (assoc 1 EL))
     )
     ;;
     ;; See if a date string is found,
     ;; save results in TMP list (mm dd yy)
     ;;
     (if (setq TMP (Y2K-TEST-Date Tx))
        ;; Found a date string, test Year value.
        (if (< (caddr TMP) 100) (progn ;;2 digit
           (prompt (strcat
              "\n** Two digit year detected - "
              (itoa (car TMP)) "/"
              (itoa (cadr TMP)) "/"
              (itoa (caddr TMP))
           ))
           ;; Apply the correction to entity
           (Y2K-ENTMOD EL TMP)
          )
           ;; Date string found, but okay
           (prompt (strcat
              "\n   Date check okay - "
                    (itoa (car TMP)) "/"
                    (itoa (cadr TMP)) "/"
                    (itoa (caddr TMP))
           ))
        )     
     )
  )
  (if SS2 (command "_REGEN"))
  (princ)
)

;; Listing 2 - Y2K-TEST-DATE, test for dates
;;
;; Checks for the following USA date formats:
;;   ##/##/##                 MM/DD/YY
;;   ##/##/####               MM/DD/YYYY
;;   sss. ##, ####            Mon. DD, YYYY
;;   ssss...sss ##, ####      Month DD, YYYY
;;
;; Side effect - sets globally scoped variable
;;               Y2K_TEST_CODE = format code
;;
(defun Y2K-TEST-DATE (S / Month_Names TMP Mon)
  (Y2K_Months) ;;build Month_Names list
  (setq Y2K_Month_Names  ;;convert to upper case
    (mapcar 
      '(lambda (TMP)
         (mapcar 'strcase TMP))
      Y2K_Month_Names)
  )
  (cond
    ((wcmatch S "##/##/*,##/#/*,#/##/*,#/#/*")
       (setq Y2K_TEST_CODE 0)
       (numb_parse S)
    )
    ((wcmatch S "##-##-*,#-##-*,##-#-*,#-#-*")
       (setq Y2K_TEST_CODE 0)
       (numb_parse (subst_str S "/" "-")))
    ;; Check for short version of name in list
    ((member (strcase (substr S 1 3))
             (mapcar 'cadr Y2K_Month_Names))
       (setq TMP (numb_parse (substr S 4))
             Y2K_TEST_CODE 1)
       (list
         (- 13
            (length 
              (member 
                 (strcase (substr S 1 3)) 
                 (mapcar 'cadr Y2K_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 Y2K_Month_Names))
          (setq TMP 
           (cons
             (- 13 ;;relative month number
               (length ;;calculation
                 (member 
                   (strcase Mon) 
                   (mapcar 'car Y2K_Month_Names)
                 )
               )
             )
             (numb_parse S) ;;remaining is day/yr
           )
          )
       )
       (if (and TMP 
                (= (length TMP) 3)
                (numberp (car TMP))
                (numberp (cadr TMP))
                (numberp (caddr TMP))
           ) (progn
         (setq Y2K_TEST_CODE 2)
         TMP ;;return TMP list
       ))    ;;else return nil if not a date str.
    )
  )
)

;; Listing 3: Y2K-ENTMOD apply correction to entity
;;
(defun Y2K-ENTMOD (EL DLIST / TH TMP PTS DX DX2)
   (setq TMP (list (car DList)
                   (cadr DList)
                   (Y2K-YEAR-FIX
                       (caddr DList))
                     )
         TMP (Y2K-DATE TMP
                        Y2K_TEST_CODE)
         TH (cdr (assoc 40 EL))
         PTS (textbox EL)
         DX (- (caadr PTS) (caar PTS))
         EL (subst
              (cons 1 TMP)
              (assoc 1 EL)
              EL)
         PTS (textbox EL)
         DX2 (- (caadr PTS) (caar PTS))
         TH (* TH (/ DX DX2))
         EL (subst
              (cons 40 TH)
              (assoc 40 EL)
              EL)
   )
   (entmod EL)
)

;; Listing 4
;;
(defun Y2K-YEAR-FIX (Num)
   ;; If number exceeds 99, then we will have
   ;; to assume that it is okay.
   (if (< NUM 100)
      ;; year is not correct, add proper
      ;; century value to it.
      (setq NUM
         (if (< NUM 50)
           (+ 2000 NUM)
           (+ 1900 NUM)))
   )
   Num
)

;; Listing 5
;;
;; Y2K-Date  converts list of three numbers into
;; date format based on code type.
;;   Code = 0   MM/DD/YYYY
;;          1   Mon. DD, YYYY
;;          2   Month DD, YYYY
;;
(defun Y2K-DATE (Date_List Code / Month_Names)
   (Y2K_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
       ) (progn
     ;;
     ;; Rebuild date list with proper year
     ;; value - 2 digit values are changed
     ;; to 4 digit values.
     ;;
     (setq Date_List
         (list (car Date_List)
               (cadr Date_List)
               (Y2K-YEAR-FIX
                  (caddr Date_List))))
     (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
    ) ;;end PROGN
     ;;else
     (prompt "\nY2K-DATE invalid input list")
   ) ;;end IF test for Date_List
)

;; Listing 6
;;
;; 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 Y2K_Months ()
  (setq Y2K_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 7
;;
(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)
)
;;
(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)