(prompt "\n\nY2K.LSP (c) 1998 Bill Kramer, is now loading.") ;;--------------------------------------------------------------------- ;; Y2K.LSP - (c) Bill Kramer 1998 ;; ;; Y2K.LSP is a function set that will seek out TEXT and ;; ATTRIBUTE objects in a drawing. It will then test each ;; found to see if it is a date string. When a date string ;; is located, the year value is tested and if it is a two ;; digit year, it is updated to a four digit year. ;; ;; This is the same program that appeared in CADENCE magazine ;; in September 1998 in my article - Programmer's Toolbox. ;; AutoLISP students are encouraged to make modifications ;; for the support of embedded date strings and then MTEXT ;; objects. ;; ;; You are on your own. This function set DOES MODIFY the ;; drawing contents so proceed with caution when customizing ;; it. Advice and further assistance is available at an ;; hourly rate from AUTO-CODE MECHANICAL / 614-792-3900 ;; ;; AUTO-CODE MECHANICAL ;; 6631 Commerce Parkway Suite E ;; Dublin, OH 43017 ;;--------------------------------------------------------------------- ;; (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) ;;----------------------------------------------- EOF (prompt "\nLoading completed, type Y2K to start the program.") (princ)