;;;;;;;;; THIS PROGRAM IS USED FOR UPDATING DWG's TO A 'CURRENT' STANDARD ;;;***************************************** ;;; Superior Designs - Custom programming available ;;; Copyright (C) 1992-1997 ;;; Written by Craig Carr - JUL. 1992 ;;; http://www.surfersnet.com/sdi/acad.htm ;;; e-mail superior@surfersnet.com ;;;***************************************** ; (DEFUN C:STD() (setq STDerr *error*) (Defun *error* (msg)(setq *error* STDerr)(PRINC "\nVERSION: 1.78") (setvar "cmdecho" 1)(princ)) (SETVAR "CMDECHO" 0) (SETVAR "OSMODE" 0) ;; THIS LINE NEEDS TO BE HERE*** (SETVAR "GRIDMODE" 0) ;;******************************** ;; set limits and scale (setq dunit 1) (SETQ DSCALE (GETREAL"\n ENTER '0' TO TYPE DIMSCALE \n ENTER SCALE of drawing in DECIMAL: ")) (IF (= DSCALE 0.0)(SETQ DSCALE (GETREAL "\n ENTER DIMSCALE: ")) (SETQ DSCALE(* (/ 1.0 DSCALE) DUNIT) ) ) (SETVAR "TEXTSIZE"(* 0.15 DSCALE)) (SETVAR "DIMSCALE" DSCALE) (SETVAR "LTSCALE"(* (GETVAR "DIMSCALE") 0.375)) (IF (/= (CAR(GETVAR "TARGET")) 0)(PROGN (COMMAND "DVIEW" "" "PO" "0,0,0" "0,0,1" "") (COMMAND "ZOOM" "E"))) (INITGET 1 "A B C D E") (SETQ DWGSIZE (GETKWORD "\nENTER SIZE OF DWG - 'A' 'B' 'C' 'D' 'E': ")) (COND ( (= DWGSIZE "A") (SETQ LIM (LIST (* DSCALE 11.00) (* DSCALE 8.5))) ) ( (= DWGSIZE "B") (SETQ LIM (LIST (* DSCALE 17.00) (* DSCALE 11.0))) ) ( (= DWGSIZE "C") (SETQ LIM (LIST (* DSCALE 22.000) (* DSCALE 17.0))) ) ( (= DWGSIZE "D") (SETQ LIM (LIST (* DSCALE 34.000) (* DSCALE 22.00))) ) ( (= DWGSIZE "E") (SETQ LIM (LIST (* DSCALE 44.000) (* DSCALE 34.00))) ) ( T (SETQ LIM (LIST 17.0 11.0)) ) ) (COMMAND "LIMITS" "0,0" LIM) (COMMAND ".ZOOM" "A") ;;;************************ END OF SET LIMITS (tblnext "layer" t) ;; reset to layer 0 (command "layer" "s" "0" "c" "white" "0" "") ; set to layer 0 (COMMAND "COLOR" "BYLAYER") (command "ucs" "") (COMMAND "BASE" "0,0") (SETVAR "LUNITS" 2)(SETVAR "LUPREC" 4) (SETVAR "AUPREC" 0) (SETVAR "FILLMODE" 1) (COMMAND "GRIDUNIT" ".25,.25") (COMMAND "SNAPUNIT" ".0625,.0625") (setvar "sortents" 1) ;; SYSTEM VARS (SETVAR "MIRRTEXT" 0) (SETVAR "REGENMODE" 0) (SETVAR "LIMCHECK" 0) (SETVAR "FILEDIA" 1) (SETVAR "UCSICON" 0) (SETVAR "BLIPMODE" 0) (SETVAR "PDMODE" 0) (setvar "coords" 2) ;; DIM VARS (SETVAR "DIMTXT" 0.15) (SETVAR "DIMASZ" 0.15) (SETVAR "DIMEXE" 0.0625) (SETVAR "DIMEXO" 0.0625) (SETVAR "DIMTIX" 1) ;*********(SETVAR "DIMGAP" 0.06) (SETVAR "dimclre" 1) (setvar "dimclrd" 1) (SETVAR "DIMCLRT" 0) (setvar "dimaso" 1) (setvar "dimtfac" 0.75) (SETVAR "DIMLFAC" 1) ;(command "insert" "*dimstyle" "0,0" "" "") ;; DEFAULT TEXT AND MAKE CURRENT (COMMAND "STYLE" "STANDARD" "SIMPLEX" "0" "1" "0" "N" "N" "N" ) ;(IF (/= (SETQ DSCALE ;(GETSTRING (STRCAT "\nENTER DIMSCALE <" (RTOS(GETVAR "DIMSCALE")) "> : ") ) ) ; "") (SETVAR "DIMSCALE" (ATOF DSCALE)) );; END IF ;(setvar "ltscale" (/ (getvar "dimscale") 2.0)) (COMMAND "ZOOM" "ALL") ;;; check layers (SETQ CEN (LIST "CEN")) (SETQ HID (LIST "HID")) (WHILE (SETQ LYR(TBLNEXT "LAYER")) (IF (AND (= (substr (CDR(ASSOC 6 LYR)) 1 6) "HIDDEN") (/= (CDR (ASSOC 2 LYR)) "HID")) (SETQ HID(LIST HID (CDR(ASSOC 2 LYR)) ))) (IF (AND (= (substr (CDR(ASSOC 6 LYR)) 1 6) "CENTER")(/= (CDR (ASSOC 2 LYR)) "CEN")) (SETQ CEN(LIST CEN (CDR(ASSOC 2 LYR)) ))) ) ;; END WHILE ;;;************ (WHILE (SETQ LYRCEN(CADR CEN)) (COMMAND "LAYER" "OFF" "*" "Y" "ON" LYRCEN "") (IF (TBLSEARCH "LAYER" "CEN") (PROGN (PRINC "\n FOUND!! extra center-line LAYER ") (INITGET "Y N") (IF (= (GETKWORD (STRCAT "\n WOULD YOU LIKE TO CONVERT ENTITIES ON LAYER <" LYRCEN "/Ltype:" (cdr(assoc 6 (tblsearch "layer" lyrcen))) "> TO LAYER CEN ? : ")) "Y") (PROGN (PRINC "\n SELECTING ENTITIES ") (IF (SETQ SSCEN(SSGET "C" (GETVAR "VSMIN")(GETVAR "VSMAX") )) (COMMAND "CHANGE" SSCEN "" "P" "LA" "CEN" "C" "BYLAYER" "LT" "BYLAYER" "") ) ) ) ) ;; END IF END PROG IF Y PROGN (PROGN (PRINC "\n FOUND!! center-line LAYER ") (INITGET "Y N") (IF (= (GETKWORD (STRCAT "\n WOULD YOU LIKE TO RENAME LAYER <" LYRCEN "> TO LAYER CEN ? : ")) "Y") (PROGN (COMMAND "RENAME" "LAYER" LYRCEN "CEN" ) ) ) ) ) ;; END PROG IF Y PROGN IF TBLSEARCH (SETQ CEN(CAR CEN)) ) ; END WHILE ;;;***************************** ;;;************ (WHILE (SETQ LYRHID(CADR HID)) (COMMAND "LAYER" "OFF" "*" "Y" "ON" LYRHID "") (IF (TBLSEARCH "LAYER" "HID") (PROGN (PRINC "\n FOUND!! extra hidden-line LAYER ") (INITGET "Y N") (if (= (GETKWORD (STRCAT "\n WOULD YOU LIKE TO CONVERT ENTITIES ON LAYER <" LYRHID "/Ltype:" (cdr(assoc 6 (tblsearch "layer" lyrhid))) "> TO LAYER HID ? : ")) "Y") (PROGN (PRINC "\n SELECTING ENTITIES ") (IF (SETQ SSHID(SSGET "C" (GETVAR "VSMIN")(GETVAR "VSMAX") )) (COMMAND "CHANGE" SSHID "" "P" "LA" "HID" "C" "BYLAYER" "LT" "BYLAYER" "") ) ) ) ) ;; END IF END PROG IF Y PROGN (PROGN (PRINC "\n FOUND!! hidden-line LAYER ") (INITGET "Y N") (IF (= (GETKWORD (STRCAT "\n WOULD YOU LIKE TO RENAME LAYER <" LYRHID "> TO LAYER HID ? : ")) "Y") (PROGN (COMMAND "RENAME" "LAYER" LYRHID "HID" ) ) ) ) ) ;; END PROG IF Y PROGN IF TBLSEARCH (SETQ HID(CAR HID)) ) ; END WHILE ;;;***************************** ;;;; LAYER COLORS (COMMAND "LAYER" "C" "WHITE" "0" "") (if (tblsearch "layer" "CEN") (command "layer" "c" "red" "cen" "")(command "layer" "n" "cen" "c" "red" "cen" "lt" "center" "cen" "")) (if (tblsearch "layer" "HID") (command "layer" "c" "52" "hid" "")(command "layer" "n" "hid" "c" "52" "hid" "lt" "hidden" "hid" "") ) (if (tblsearch "layer" "PHAN") (command "layer" "c" "RED" "phan" "")(command "layer" "n" "PHAN" "c" "RED" "PHAN" "LT" "PHANTOM" "PHAN" "") ) (if (tblsearch "layer" "THK") (command "layer" "c" "RED" "THK" "") ) (if (tblsearch "layer" "DIM") (PROGN (command "layer" "c" "yellow" "DIM" "") ;(COMMAND "LAYER" "OFF" "*" "Y" "ON" "DIM" "") ; (PRINC "\n SELECTING 'DIM' LAYER ENTITIES ") ; (IF (SETQ SSHID(SSGET "C" (GETVAR "VSMIN")(GETVAR "VSMAX") )) ; (COMMAND "CHANGE" SSHID "" "P" "C" "BYLAYER" "LT" "BYLAYER" "") ; );END IF )(command "layer" "n" "dim" "c" "yellow" "dim" "") ) ; END PROG END IF (if (tblsearch "layer" "THIN") (command "layer" "c" "cyan" "THIN" "") ) (tblnext "layer" t) ;; reset to layer 0 ;;;******* (princ "CONVERTING HIDDEN & CENTER LINES") (SETQ LAYRent(SSGET "X" (LIST (CONS 6 (STRCAT "hid" "*"))))) (IF (= LAYRent nil)(PRINC "\n NO HIDDEN lines!") (PROGN (PRINC (STRCAT "\n HIDDEN LINES found: " (ITOA (SSLENGTH LAYRent)) ) ) (COMMAND "CHANGE" LAYRent "" "P" "LA" "HID" "C" "BYLAYER" "LT" "BYLAYER" "") ));END PROG END IF (SETQ LAYRent(SSGET "X" (LIST (CONS 6 (STRCAT "cen" "*"))))) (IF (= LAYRent nil)(PRINC "\n NO CENTER lines!") (PROGN(PRINC (STRCAT "\n CENTER LINES found: " (ITOA (SSLENGTH LAYRent)) ) ) (COMMAND "CHANGE" LAYRent "" "P" "LA" "Cen" "C" "BYLAYER" "LT" "BYLAYER" "") ));END PROG END IF ;;;********* ;;;************************** (IF (TBLSEARCH "LAYER" "TEXT") (PROGN (COMMAND "LAYER" "OFF" "*" "Y" "ON" "TEXT" "C" "YELLOW" "TEXT" "") (PRINC "\n FOUND!! extra LAYER ") (INITGET "Y N") (IF (= (GETKWORD (STRCAT "\n WOULD YOU LIKE TO CONVERT ENTITIES ON LAYER TO LAYER DIM ? : ")) "Y") (PROGN (PRINC "\n SELECTING 'TEXT' LAYER ENTITIES ") (IF (SETQ SSHID(SSGET "C" (GETVAR "VSMIN")(GETVAR "VSMAX") )) (COMMAND "CHANGE" SSHID "" "P" "LA" "DIM" "C" "BYLAYER" "LT" "BYLAYER" "") );END IF ) ) ;; END PROG END IF KWORD )) ; END PROG END IF TBLS ;;*************************** ;;;************************** (IF (TBLSEARCH "LAYER" "DIMENSIONS") (PROGN (COMMAND "LAYER" "OFF" "*" "Y" "ON" "DIMENSIONS" "") (PRINC "\n FOUND!! extra LAYER ") (INITGET "Y N") (IF (= (GETKWORD (STRCAT "\n WOULD YOU LIKE TO CONVERT ENTITIES ON LAYER TO LAYER DIM ? : ")) "Y") (PROGN (PRINC "\n SELECTING 'DIMENSIONS' LAYER ENTITIES ") (IF (SETQ SSHID(SSGET "C" (GETVAR "VSMIN")(GETVAR "VSMAX") )) (COMMAND "CHANGE" SSHID "" "P" "LA" "DIM" "") );END IF ) ) ;; END PROG END IF KWORD )) ; END PROG END IF TBLS ;;*************************** ;;;************************** (IF (TBLSEARCH "LAYER" "TITLETEXT") (PROGN (COMMAND "LAYER" "OFF" "*" "Y" "ON" "TITLETEXT" "") (PRINC "\n SELECTING 'TITLETEXT' LAYER ENTITIES ") (IF (SETQ SSHID(SSGET "C" (GETVAR "VSMIN")(GETVAR "VSMAX") )) (COMMAND "CHANGE" SSHID "" "P" "LA" "DIM" "C" "BYLAYER" "LT" "BYLAYER" "") );END IF )) ; END PROG END IF TBLS ;;*************************** ;;;************************** (IF (TBLSEARCH "LAYER" "OBJ") (PROGN (COMMAND "LAYER" "OFF" "*" "Y" "ON" "OBJ" "") (PRINC "\n FOUND!! extra LAYER ") (INITGET "Y N") (IF (= (GETKWORD (STRCAT "\n WOULD YOU LIKE TO CONVERT ENTITIES ON LAYER TO LAYER 0 ? : ")) "Y") (PROGN (PRINC "\n SELECTING 'OBJ' LAYER ENTITIES ") (IF (SETQ SSHID(SSGET "C" (GETVAR "VSMIN")(GETVAR "VSMAX") )) (COMMAND "CHANGE" SSHID "" "P" "LA" "0" "C" "BYLAYER" "LT" "BYLAYER" "") );END IF ) ) ;; END PROG END IF KWORD )) ; END PROG END IF TBLS ;;*************************** ;;;************************** (IF (TBLSEARCH "LAYER" "OBJECTS") (PROGN (COMMAND "LAYER" "OFF" "*" "Y" "ON" "OBJECTS" "") (PRINC "\n FOUND!! extra LAYER ") (INITGET "Y N") (IF (= (GETKWORD (STRCAT "\n WOULD YOU LIKE TO CONVERT ENTITIES ON LAYER TO LAYER 0 ? : ")) "Y") (PROGN (PRINC "\n SELECTING 'OBJECTS' LAYER ENTITIES ") (IF (SETQ SSHID(SSGET "C" (GETVAR "VSMIN")(GETVAR "VSMAX") )) (COMMAND "CHANGE" SSHID "" "P" "LA" "0" "C" "BYLAYER" "LT" "BYLAYER" "") );END IF ) ) ;; END PROG END IF KWORD )) ; END PROG END IF TBLS ;;*************************** ;;;************************** (IF (TBLSEARCH "LAYER" "BORDER")(PROGN (if (tblsearch "layer" "BORD")(PROGN (princ "\n YOU HAVE BOTH LAYER 'BORD' AND LAYER 'BORDER' ") (PRINC "\n WHAT IS YOUR PROBLEM! PLEASE CORRECT THIS") (PRINC "\n FORGET IT... RENAMING LAYER 'BORD' TO 'JUNK' ... " ) (COMMAND "RENAME" "LA" "BORD" "JUNK") )) ; (COMMAND "RENAME" "LA" "BORDER" "BORD" ) (COMMAND "LAYER" "C" "RED" "BORDER" "") ) ) (SETVAR "REGENMODE" 1) (COMMAND "VIEWRES" "" "2000") (COMMAND "LAYER" "ON" "*" "") (PRINC "\n DONE..... ") (PRINC "\n YOU MAY NOW PURGE YOUR DWG ") (setq *error* STDerr) (SETVAR "CMDECHO" 1)(PRINC) ) ;;; END OF FUNCTION ;;;;;;;;;;;;************