AutoCAD

The Year 2000: No Problem, Man

1 Sep, 1998 By: Bill Kramer

Program Listings


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


About the Author: Bill Kramer


AutoCAD Tips!

Lynn Allen

Autodesk Technical Evangelist Lynn Allen guides you through a different AutoCAD feature in every edition of her popular "Circles and Lines" tutorial series. For even more AutoCAD how-to, check out Lynn's quick tips in the Cadalyst Video Gallery. Subscribe to Cadalyst's free Tips & Tools Weekly e-newsletter and we'll notify you every time a new video tip is published. All exclusively from Cadalyst!
Follow Lynn on Twitter Follow Lynn on Twitter


Poll
Which of the following do you share CAD files with most often?
Coworkers in your department
Other departments or remote offices within your company
Vendors, contractors, or partners outside your company
Clients or nontechnical stakeholders
No one
Submit Vote