AutoCAD
The Year 2000: No Problem, Man
31 Aug, 1998 By: Bill KramerProgram 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) |
More News and Resources from Cadalyst Partners
For Mold Designers! Cadalyst has an area of our site focused on technologies and resources specific to the mold design professional. Sponsored by Siemens NX. Visit the Equipped Mold Designer here!
For Architects! Cadalyst has an area of our site focused on technologies and resources specific to the building design professional. Sponsored by HP. Visit the Equipped Architect here!