;;;***************************************** ;;; Copyright (C) 1992-2005 BY SUPERIOR DESIGNS ;;; Written by Craig Carr - NOV. 1992-2005 ;;; http://www.surfersnet.com/sdi/acad.htm ;;; e-mail superior@surfersnet.com ;;;***************************************** (SETVAR "CMDECHO" 0)(PRINC "\n LOADING MD.....") (SETQ TEXTL "DIM") ;;;;;; LAYER FOR TEXT ENTITIES (SETQ DIML "DIM") ;;;;;;; LAYER FOR DIM ENTITIES (SETVAR "DIMCLRD" 1) ;;; COLOR FOR DIMENSION LINES ie. 0=BYBLOCK 3=GREEN (SETVAR "DIMCLRE" 1) ;;; COLOR FOR EXTENSION LINES ie. 0=BYBLOCK 3=GREEN (SETVAR "DIMCLRT" 0) ;;; COLOR FOR TEXT ie. 256=BYLAYER 3=GREEN ;;; cecolor to force color of defpoints;;; (SETVAR "DIMaso" 1) (SETVAR "DIMTXT" 0.125) (SETVAR "TEXTSIZE" 0.125) (setvar "dimtfac" 0.75) ;; text size of tolerances (SETQ DSCALE (GETVAR "DIMSCALE")) (SETQ OLDUNITS(GETVAR "LUNITS"))(SETQ OLDLUPREC(GETVAR "LUPREC")) (SETQ DIMUNIT (GETVAR "LUNITS"))(SETQ DIMPREC (GETVAR "LUPREC")) (SETQ MDCMD nil) (setq dimprec 3) (setvar "dimzin" 4) (setvar "dimtzin" 4) ; (IF (= (TBLSEARCH "DIMSTYLE" "AA") nil) ; (PROGN (LOAD"DSTYLE")(C:DSTYLE))) ;;;;;;******************************************************* START OF MD (DEFUN C:DIMHELP()(COMMAND "TEXTSCR") (PRINC "\n\n\n H - Horizontal Dimension Utility with Online Variable Adjustments") (PRINC "\n and Selective Updating of ASSOCIATIVE or EXPLODED DIMENSIONS ") (PRINC "\n\n At the prompt, activate an option by typing the capitol letter associated") (princ "\n with the option. ie. To activate the 'Sup' option, type 'S' ") (PRINC "\n\n EXPLANATION of Command Line and Options:") (PRINC "\n\n DIM STYLE:<'CURRENT' dimstyle>") (PRINC "\n Sup - suppress both extension lines") (PRINC "\n Ext - use both extension lines") (PRINC "\n Dec - use decimal dimension, prompts for places ") (PRINC "\n Frac- use fraction dimension ") (PRINC "\n Update - selected dimensions, leaders, text, AND/OR lines will be UPDATED") (PRINC "\n to current settings; including color and layer settings based upon") (PRINC "\n variables at the beginning of this program. ALSO, any text that is") (PRINC "\n updated will have the Post Text added to it.") (PRINC "\n ie. If Post Text = \" and the selected text = .25 the UPDATE will be: .25\"") (PRINC "\n Move - move dimension text") (PRINC "\n ST - set tolerances") (PRINC "\n <24.14> - SAMPLE of dimension text including any Post Text") (GETSTRING "\n\n Press ENTER to continue") (PRINC "\n\n THE SECOND LINE SHOWS CURRENT SETTINGS IN <>") (PRINC "\n\n S1 - suppress first extension line") (PRINC "\n S2 - suppress second extension line") (PRINC "\n Text inside - force text inside dimension line") (PRINC "\n Align text - align dimension text along dimension line") (PRINC "\n Limit - use LIMIT dimensioning ie. .375/.378") (PRINC "\n tOls - use tolerances ie. .375 +.002/-.003") (PRINC "\n DF - dimension scale factor ie. if you need a metric dimension on an inch dwg") (PRINC "\n Post text - text to put after a dimension ie. REF, TYP, \"; include any spaces") (PRINC "\n First extension line origin or RETURN to select: - THIS IS THE PROMPT ") (GETSTRING "\n\n Press ENTER to return to Drawing Screen.") (COMMAND "graphscr")); END FUNCTION DIMHELP ;;;;;;***************** ;;;;;****************** (defun c:md()(SETVAR "CMDECHO" 0) ;;;;;;******** ERROR HANDLING (setq MDerr *error*) (Defun *error* (msg)(setq *error* MDerr)(setvar "LUNITS" OLDUNITS)(SETVAR "LUPREC" OLDLUPREC) (PRINC (STRCAT "\nVERSION : " MDVER)) (PRINC (STRCAT "\nCURRENT STYLE : " (GETVAR "DIMSTYLE") )) (setvar "cmdecho" 1)(princ)) ;;;;;;;******** END ERROR (SETQ DWGDS (GETVAR "DIMSCALE")) (SETQ DIMASK "U")(SETQ DIMASKOLD "U") (SETQ STYASK "E")(SETQ STYASKOLD "E") (SETQ MDVER "3.65") (SETQ MDCMD 1) ;;;;;;;******** STARTUP FUNCTIONS (IF (= MDCMD nil)(PROGN ; (PRINC "\n INITIALIZING, PLEASE WAIT ....") (SETQ DWGDS (GETVAR "DIMSCALE")) (SETQ DIMASK "U")(SETQ DIMASKOLD "U") (SETQ STYASK "E")(SETQ STYASKOLD "E") (SETQ MDVER "3.60") (SETQ MDCMD 1)(^C) )) ;;; END PROG END IF ;;;;;;**************** ;; END OF STARTUP ;;;;;;**************** (IF (/= DWGDS (GETVAR "DIMSCALE"))(PROGN (PRINC "\n *ERROR* YOU HAVE CHANGED YOUR DIMSCALE !!! RELOAD or") (PRINC "\n MD WILL NOT WORK UNLESS YOU CORRECT THE PROBLEM OR eset dimstyles. ") (INITGET "R")(IF (= (GETKWORD) "R") (PROGN (SETQ DWGDS (GETVAR "DIMSCALE")) (IF (= (TBLSEARCH "DIMSTYLE" "AA") nil) (PROGN (LOAD"DSTYLE")(C:DSTYLE)) ) (LOAD"DSTYLE")(C:DSTYLE) )) ;; END PROGN SET DWGDS END IF 'R' (^C^C) )) ;; END PROGN END IF DWGDS ;;************** (SETQ OLDUNITS(GETVAR "LUNITS"))(SETQ OLDLUPREC(GETVAR "LUPREC")) (SETVAR "LUNITS" DIMUNIT)(SETVAR "LUPREC" DIMPREC) (INITGET "U M A") (IF (= (SETQ DIMASK(GETKWORD (STRCAT "\n (U)pdate dim to current/(M)atch dim/(A)ssign dimstyles <" DIMASKOLD "> : " ) )) nil)(SETQ DIMASK DIMASKOLD)(SETQ DIMASKOLD DIMASK) ) ;;;;*********MATCH DIMENSION (IF (= DIMASK "M")(PROGN (PRINC "\n ")(PRINC "\n ") (SETQ CHGDIM(ENTSEL "\n PICK DIMENSION TO CHANGE")) (SETQ MATDIM(ENTSEL "\n PICK DIMENSION TO MATCH ")) (COMMAND "DIM" "RES" "" MATDIM "UPD" CHGDIM "" "EXIT") )) ;; END PROG END IF M ;;;******** ;;;****** UPDATE DIMENSION(s) (IF (= DIMASK "U")(PROGN (PRINC "\n ") (princ (STRCAT "\n PICK DIMENSION(s) TO UPDATE to 'current settings' - COLORS, UNITS, and/or STYLE <" (GETVAR "DIMSTYLE") "> ") ) (setq ssdim(ssget)) (COMMAND "DIM")(SETQ I 0) (IF (= (SETQ ENTCLR(ITOA(GETVAR "DIMCLRD"))) "0")(SETQ ENTCLR "BYLAYER")) (WHILE (< I (SSLENGTH SSDIM)) (IF (= (CDR (ASSOC 0 (ENTGET(SSNAME SSDIM I)) )) "DIMENSION") (progn (COMMAND "UPD" (SSNAME SSDIM I) "") (command "exit" "change" (ssname ssdim i) "" "p" "la" DIML "" "dim") ) ;;ELSE (PROGN (IF (= (CDR (ASSOC 0 (setq uent(ENTGET(SSNAME SSDIM I))) )) "TEXT") (PROGN (COMMAND "EXIT") ;;; FOR TEXT ;**** (IF (/= (CDR(ASSOC 7 UENT)) "STANDARD")(PROGN (IF (= (CDR(ASSOC 72 UENT)) 5) (setq uent(subst (cons 72 0)(ASSOC 72 UENT) UENT)) ) (setq uent(subst (cons 7 "STANDARD")(ASSOC 7 UENT) UENT)) (ENTMOD UENT) )) ;**** (COMMAND "CHANGE" (SSNAME SSDIM I) "" "" "" "" "" "" (STRCAT (CDR(ASSOC 1 (ENTGET (SSNAME SSDIM I)))) (GETVAR "DIMPOST")) ) (COMMAND "CHANGE" (SSNAME SSDIM I) "" "P" "C" "BYLAYER" "LA" TEXTL "" ) (COMMAND "DIM") );; END PROGN (PROGN (COMMAND "EXIT") ;;; CHANGE COLORS (COMMAND "CHANGE" (SSNAME SSDIM I) "" "P" "C" ENTCLR "LA" DIML "" ) (COMMAND "DIM") );; END PROGN ) ) ); END IF TEXT; END ELSE PROGN; END IF DIM (SETQ I(1+ I)) ) ; END WHILE (COMMAND "EXIT") )) ;; END PROGN END IF U ;;;;;************************ ;;;********** ASSIGN DIMSTYLES (IF (= DIMASK "A") (PROGN (PRINC "\n ") (IF (= (TBLSEARCH "DIMSTYLE" "AA") nil)(progn (princ "\n YOU CANNOT USE THIS COMMAND UNITIL THE DIMSTYLES HAVE BEEN LOADED") (SETQ MDCMD nil)(^C) )) (INITGET "E S S1 S2")(PRINC "\n USE DIMSTYLE WITH WHICH PROPERTIES ? ") (IF (= (SETQ STYASK(GETKWORD (STRCAT "\n (E)xt/(S)uppress ext/(S1)first ext/(S2)second ext <" STYASKOLD "> : ") )) nil)(SETQ STYASK STYASKOLD)(SETQ STYASKOLD STYASK) ) (IF (= STYASK "E")(COMMAND "DIM" "RES" "EXT" "EXIT")) (IF (= STYASK "S")(COMMAND "DIM" "RES" "SUP" "EXIT")) (IF (= STYASK "S1")(COMMAND "DIM" "RES" "S1" "EXIT")) (IF (= STYASK "S2")(COMMAND "DIM" "RES" "S2" "EXIT")) (princ (STRCAT "\n PICK DIMENSION(s) TO CHANGE TO DIMSTYLE <" STYASK "> ")) (PRINC "\n or Press RETURN to make Current ") (COMMAND "DIM") (IF (= (setq ssdim(ssget)) nil)(^c^c)) (SETQ I 0) (WHILE (< I (SSLENGTH SSDIM)) (COMMAND "UPD" (SSNAME SSDIM I) "") (SETQ I(1+ I)) ) ; END WHILE (COMMAND "EXIT") )) ; END PROGN END IF A (setq *error* MDerr) (SETVAR "LUNITS" OLDUNITS)(SETVAR "LUPREC" OLDLUPREC) (SETVAR "CMDECHO" 1)(PRINC) ) ; END OF FUNCTION MD ;;;;;;***************** (PRINC ".") ;;;;;;***************** ;;;;;;***************** (defun c:h ()(setq herr *error* clyr (getvar "CLAYER") x ">: " 1p nil enth nil entd nil)(setvar "CMDECHO" 0) (defun *error* (msg)(setq *error* herr)(command "layer" "s" clyr "") (setvar "LUNITS" OLDUNITS)(SETVAR "LUPREC" OLDLUPREC) (setvar "CMDECHO" 1)(princ)) (SETQ OLDUNITS(GETVAR "LUNITS"))(SETQ OLDLUPREC(GETVAR "LUPREC")) (SETQ ODLIM (GETVAR "DIMLIM"))(SETQ ODTOL (GETVAR "DIMTOL")) (SETVAR "LUNITS" DIMUNIT)(SETVAR "LUPREC" DIMPREC) (command "layer" "s" dimL "") (INITGET "S1 S2 T A U P S E L O ST D F M DF ?") (WHILE (/= (TYPE 1p) 'list) (setq 1p(getpoint (STRCAT ; "\n " "\nDIM STYLE :<" (GETVAR "DIMSTYLE") "> Sup/Ext/Dec/Frac/Update/Move/ST-set tols/? <" (RTOS 24.14) (GETVAR "DIMPOST") "> " "\n S1 <" (ITOA(getvar "dimse1")) "> S2 <" (ITOA(getvar "dimse2")) "> Text inside <" (ITOA(getvar "dimtix")) "> Align txt <" (ITOA(GETVAR "DIMTIH")) "> Limit <" (ITOA(GETVAR "DIMLIM")) "> tOls <" (ITOA(GETVAR "DIMTOL")) "> DF factor <" (RTOS(GETVAR "DIMLFAC")) "> Post txt <" (GETVAR "DIMPOST") "> " "\nFirst extension line origin or RETURN to select: ") )) (COND ( (= 1P "S1")(PROGN(SETVAR "DIMSE1" (- 1 (GETVAR "DIMSE1"))) (INITGET "S1 S2 T A U P S E L O ST D F M DF ?"))) ( (= 1P "S2")(PROGN(SETVAR "DIMSE2" (- 1 (GETVAR "DIMSE2"))) (INITGET "S1 S2 T A U P S E L O ST D F M DF ?"))) ( (= 1P "T") (PROGN(SETVAR "DIMTIX" (- 1 (GETVAR "DIMTIX"))) (INITGET "S1 S2 T A U P S E L O ST D F M DF ?")) ) ; END COND ( (= 1P "A")(PROGN (SETVAR "DIMTIH" (- 1 (GETVAR "DIMTIH"))) (SETVAR "DIMTOH" (GETVAR "DIMTIH"))(INITGET "S1 S2 T A U P S E L O ST D F M DF ?"))) ( (= 1P "U")(PROGN (PRINC "\n ") (princ (STRCAT "\n PICK DIMENSION(s) TO UPDATE to 'current settings' - COLORS, UNITS, and/or STYLE <" (GETVAR "DIMSTYLE") "> ") ) (setq ssdim(ssget))(COMMAND "DIM")(SETQ I 0) (IF (= (SETQ ENTCLR(ITOA(GETVAR "DIMCLRD"))) "0")(SETQ ENTCLR "BYLAYER")) (WHILE (< I (SSLENGTH SSDIM))(IF (= (CDR (ASSOC 0 (ENTGET(SSNAME SSDIM I)) )) "DIMENSION") ; (COMMAND "RES" "" (SSNAME SSDIM I) "UPD" (SSNAME SSDIM I) "") (COMMAND "UPD" (SSNAME SSDIM I) "") (PROGN (IF (= (CDR (ASSOC 0 (setq uent(ENTGET(SSNAME SSDIM I))) )) "TEXT") (PROGN (COMMAND "EXIT") ;;; FOR TEXT (IF (/= (CDR(ASSOC 7 UENT)) "STANDARD")(PROGN (IF (= (CDR(ASSOC 72 UENT)) 5) (setq uent(subst (cons 72 0)(ASSOC 72 UENT) UENT)) ) (setq uent(subst (cons 7 "STANDARD")(ASSOC 7 UENT) UENT))(ENTMOD UENT) )) (COMMAND "CHANGE" (SSNAME SSDIM I) "" "" "" "" (* (GETVAR "DIMTXT")(GETVAR "DIMSCALE")) "" "" (STRCAT (CDR(ASSOC 1 (ENTGET (SSNAME SSDIM I)))) (GETVAR "DIMPOST")) ) (COMMAND "CHANGE" (SSNAME SSDIM I) "" "P" "C" "BYLAYER" "LA" TEXTL "" ) (COMMAND "DIM") );; END PROGN (PROGN (COMMAND "EXIT") ;;; CHANGE COLORS (COMMAND "CHANGE" (SSNAME SSDIM I) "" "P" "C" ENTCLR "LA" DIML "" ) (COMMAND "DIM") );; END PROGN ) ) ); END IF TEXT; END ELSE PROGN; END IF DIM (SETQ I(1+ I)) ) ; END WHILE (INITGET "S1 S2 T A U P S E L O ST D F M DF ?")(COMMAND "EXIT") )) ;; END PROGN END COND U ( (= 1P "P")(PROGN (IF (= (SETQ PTXT(GETSTRING T "\n NEW POST TEXT ? : ")) "") (COMMAND "DIM" "DIMPOST" "." "EXIT")(COMMAND "DIM" "DIMPOST" (STRCAT "<> " PTXT) "EXIT")) (INITGET "S1 S2 T A U P S E L O ST D F M DF ?") )) ;; END PROGN END COND ( (= 1P "S")(PROGN(SETVAR "DIMSE1" 1)(SETVAR "DIMSE2" 1) (INITGET "S1 S2 T A U P S E L O ST D F M DF ?"))) ( (= 1P "E")(PROGN(SETVAR "DIMSE1" 0)(SETVAR "DIMSE2" 0) (INITGET "S1 S2 T A U P S E L O ST D F M DF ?"))) ( (= 1P "L")(PROGN (IF (= (GETVAR "DIMLIM") 0)(PROGN (SETVAR "DIMTFAC" 1) (SETVAR "DIMLIM" 1)(SETVAR "DIMTOL" 0) (IF (/= (SETQ TUP(GETSTRING (STRCAT "\n ENTER UPPER LIMIT <" (RTOS(GETVAR "DIMTP")) ">: ")) ) "")(SETVAR "DIMTP" (ATOF TUP)) ) (IF (/= (SETQ TUP(GETSTRING (STRCAT "\n ENTER LOWER LIMIT <" (RTOS(GETVAR "DIMTM")) ">: ")) ) "")(SETVAR "DIMTM" (ATOF TUP)) ) ) ;END PROG (SETVAR "DIMLIM" 0)) ;; END IF (INITGET "S1 S2 T A U P S E L O ST D F M DF ?") )) ;; END PROGN END COND ( (= 1P "O")(PROGN (IF (= (GETVAR "DIMTOL") 0)(PROGN (SETVAR "DIMLIM" 0)(SETVAR "DIMTOL" 1) (SETVAR "DIMTFAC" 0.75) (INITGET "S1 S2 T A U P S E L O ST D F M DF ?") ); end progn (progn (SETVAR "DIMTOL" 0) (INITGET "S1 S2 T A U P S E L O ST D F M DF ?") )); end prog if )) ;; END PROGN END IF ( (= 1P "ST")(PROGN (IF (/= (SETQ TUP(GETSTRING (STRCAT "\n ENTER UPPER LIMIT <" (RTOS(GETVAR "DIMTP")) ">: ")) ) "")(SETVAR "DIMTP" (ATOF TUP)) ) (IF (/= (SETQ TUP(GETSTRING (STRCAT "\n ENTER LOWER LIMIT <" (RTOS(GETVAR "DIMTM")) ">: ")) ) "")(SETVAR "DIMTM" (ATOF TUP)) ) (INITGET "S1 S2 T A U P S E L O ST D F M DF ?") )) ;; END PROG END IF ( (= 1P "D")(PROGN (SETVAR "LUNITS" 2) (SETQ DIMUNIT 2) (INITGET "0 1 2 3 4 5") (IF (= (SETQ DPLC(GETSTRING "\n PLACE-0,1,2,3,4,5 <3>")) "") (SETVAR "LUPREC" 3) (SETVAR "LUPREC" (ATOI DPLC)) ) (SETQ DIMPREC (GETVAR "LUPREC")) ;(SETVAR "AUPREC" DIMPREC) (SETVAR "dimdec" dimprec) (SETVAR "dimtdec" dimprec) (INITGET "S1 S2 T A U P S E L O ST D F M DF ?"))) ( (= 1P "F")(PROGN (SETVAR "LUNITS" 5)(SETVAR "LUPREC" 5)(SETQ DIMUNIT 5)(SETQ DIMPREC 5) (INITGET "S1 S2 T A U P S E L O ST D F M DF ?"))) ( (= 1P "M")(PROGN (COMMAND "DIM" "TEDIT" PAUSE PAUSE "EXIT") (INITGET "S1 S2 T A U P S E L O ST D F M DF ?"))) ( (= 1P "DF")(PROGN(INITGET 1 "M I 1 T") (SETQ DPLC(GETKWORD "\n DIM FACTOR - etric/nch/<1>/ype# :")) (COND ( (= DPLC "M")(SETVAR "DIMLFAC" 25.4)) ( (= DPLC "I")(SETVAR "DIMLFAC" (/ 1.0 25.4))) ( (= DPLC "1")(SETVAR "DIMLFAC" 1)) ( (= DPLC "T")(SETVAR "DIMLFAC" (ATOF(GETSTRING "\n ENTER NEW DIM FACTOR: ")) ) )) (INITGET "S1 S2 T A U P S E L O ST D F M DF ?"))) ( (= 1P "?")(PROGN (C:DIMHELP) (INITGET "S1 S2 T A U P S E L O ST D F M DF ?"))) ( (= 1p nil)(progn (setq entd(entget(car(setq enth(entsel "\Select line, arc or circle: "))))) (IF (= (CDR(ASSOC 0 ENTD)) "LINE") (setq dx(strcat(rtos(abs(- (cadr(assoc 10 entd)) (cadr(assoc 11 entd)) ) ) 2) "\"") ) ; end setq dx ;; OTHERWISE (SETQ DX "") ) ; END IF LINE (setq 1p (cadr enth)) (initget "S1 S2 T A U P S E L O ST D F M DF ?") ) ) ;;END PROG nil END COND nil );END COND ) ; END WHILE 1P (IF (= ENTH nil) (progn(setq 2p (getpoint "\nSecond extension line origin: ")) (setq dx(strcat(rtos(abs(- (car 1p)(car 2p))) ) )) ) ) ;; END IF (setq dloc (getpoint "\nDimension line location: ")) ;(C:TOL) (setq dtxt (getstring (strcat "\nDimension text <" dx ">: ") )) (if (= dtxt nil)(setq dtxt dx)) (if(/= enth nil)(command "dim" "hor" "" enth dloc dtxt "exit") (command "dim" "hor" 1p 2p dloc dtxt "exit" "layer" "s" clyr "")) (setvar "LUNITS" OLDUNITS)(SETVAR "LUPREC" OLDLUPREC) (setq *error* herr)(setvar "CMDECHO" 1) (princ)) ;;;;;;;;;;;;************ (PRINC ".") ;;;;;;***************** (defun c:v ()(setq herr *error* clyr (getvar "CLAYER") x ">: " 1p nil enth nil entd nil)(setvar "CMDECHO" 0) (defun *error* (msg)(setq *error* herr)(command "layer" "s" clyr "") (setvar "LUNITS" OLDUNITS)(SETVAR "LUPREC" OLDLUPREC) (setvar "CMDECHO" 1)(princ)) (SETQ OLDUNITS(GETVAR "LUNITS"))(SETQ OLDLUPREC(GETVAR "LUPREC")) (SETQ ODLIM (GETVAR "DIMLIM"))(SETQ ODTOL (GETVAR "DIMTOL")) (SETVAR "LUNITS" DIMUNIT)(SETVAR "LUPREC" DIMPREC) (command "layer" "s" dimL "") (INITGET "S1 S2 T A U P S E L O ST D F M DF ?") (WHILE (/= (TYPE 1p) 'list) (setq 1p(getpoint (STRCAT ; "\n " "\nDIM STYLE :<" (GETVAR "DIMSTYLE") "> Sup/Ext/Dec/Frac/Update/Move/ST-set tols/? <" (RTOS 24.14) (GETVAR "DIMPOST") "> " "\n S1 <" (ITOA(getvar "dimse1")) "> S2 <" (ITOA(getvar "dimse2")) "> Text inside <" (ITOA(getvar "dimtix")) "> Align txt <" (ITOA(GETVAR "DIMTIH")) "> Limit <" (ITOA(GETVAR "DIMLIM")) "> tOls <" (ITOA(GETVAR "DIMTOL")) "> DF factor <" (RTOS(GETVAR "DIMLFAC")) "> Post txt <" (GETVAR "DIMPOST") "> " "\nFirst extension line origin or RETURN to select: ") )) (COND ( (= 1P "S1")(PROGN(SETVAR "DIMSE1" (- 1 (GETVAR "DIMSE1"))) (INITGET "S1 S2 T A U P S E L O ST D F M DF ?"))) ( (= 1P "S2")(PROGN(SETVAR "DIMSE2" (- 1 (GETVAR "DIMSE2"))) (INITGET "S1 S2 T A U P S E L O ST D F M DF ?"))) ( (= 1P "T") (PROGN(SETVAR "DIMTIX" (- 1 (GETVAR "DIMTIX"))) (INITGET "S1 S2 T A U P S E L O ST D F M DF ?")) ) ; END COND ( (= 1P "A")(PROGN (SETVAR "DIMTIH" (- 1 (GETVAR "DIMTIH"))) (SETVAR "DIMTOH" (GETVAR "DIMTIH"))(INITGET "S1 S2 T A U P S E L O ST D F M DF ?"))) ( (= 1P "U")(PROGN (PRINC "\n ") (princ (STRCAT "\n PICK DIMENSION(s) TO UPDATE to 'current settings' - COLORS, UNITS, and/or STYLE <" (GETVAR "DIMSTYLE") "> ") ) (setq ssdim(ssget))(COMMAND "DIM")(SETQ I 0) (IF (= (SETQ ENTCLR(ITOA(GETVAR "DIMCLRD"))) "0")(SETQ ENTCLR "BYLAYER")) (WHILE (< I (SSLENGTH SSDIM))(IF (= (CDR (ASSOC 0 (ENTGET(SSNAME SSDIM I)) )) "DIMENSION") ; (COMMAND "RES" "" (SSNAME SSDIM I) "UPD" (SSNAME SSDIM I) "") (COMMAND "UPD" (SSNAME SSDIM I) "") (PROGN (IF (= (CDR (ASSOC 0 (setq uent(ENTGET(SSNAME SSDIM I))) )) "TEXT") (PROGN (COMMAND "EXIT") ;;; FOR TEXT (IF (/= (CDR(ASSOC 7 UENT)) "STANDARD")(PROGN (IF (= (CDR(ASSOC 72 UENT)) 5) (setq uent(subst (cons 72 0)(ASSOC 72 UENT) UENT)) ) (setq uent(subst (cons 7 "STANDARD")(ASSOC 7 UENT) UENT))(ENTMOD UENT) )) (COMMAND "CHANGE" (SSNAME SSDIM I) "" "" "" "" (* (GETVAR "DIMTXT")(GETVAR "DIMSCALE")) "" "" (STRCAT (CDR(ASSOC 1 (ENTGET (SSNAME SSDIM I)))) (GETVAR "DIMPOST")) ) (COMMAND "CHANGE" (SSNAME SSDIM I) "" "P" "C" "BYLAYER" "LA" TEXTL "" ) (COMMAND "DIM") );; END PROGN (PROGN (COMMAND "EXIT") ;;; CHANGE COLORS (COMMAND "CHANGE" (SSNAME SSDIM I) "" "P" "C" ENTCLR "LA" DIML "" ) (COMMAND "DIM") );; END PROGN ) ) ); END IF TEXT; END ELSE PROGN; END IF DIM (SETQ I(1+ I)) ) ; END WHILE (INITGET "S1 S2 T A U P S E L O ST D F M DF ?")(COMMAND "EXIT") )) ;; END PROGN END COND U ( (= 1P "P")(PROGN (IF (= (SETQ PTXT(GETSTRING T "\n NEW POST TEXT ? : ")) "") (COMMAND "DIM" "DIMPOST" "." "EXIT")(COMMAND "DIM" "DIMPOST" (STRCAT "<> " PTXT) "EXIT")) (INITGET "S1 S2 T A U P S E L O ST D F M DF ?") )) ;; END PROGN END COND ( (= 1P "S")(PROGN(SETVAR "DIMSE1" 1)(SETVAR "DIMSE2" 1) (INITGET "S1 S2 T A U P S E L O ST D F M DF ?"))) ( (= 1P "E")(PROGN(SETVAR "DIMSE1" 0)(SETVAR "DIMSE2" 0) (INITGET "S1 S2 T A U P S E L O ST D F M DF ?"))) ( (= 1P "L")(PROGN (IF (= (GETVAR "DIMLIM") 0)(PROGN (SETVAR "DIMTFAC" 1) (SETVAR "DIMLIM" 1)(SETVAR "DIMTOL" 0) (IF (/= (SETQ TUP(GETSTRING (STRCAT "\n ENTER UPPER LIMIT <" (RTOS(GETVAR "DIMTP")) ">: ")) ) "")(SETVAR "DIMTP" (ATOF TUP)) ) (IF (/= (SETQ TUP(GETSTRING (STRCAT "\n ENTER LOWER LIMIT <" (RTOS(GETVAR "DIMTM")) ">: ")) ) "")(SETVAR "DIMTM" (ATOF TUP)) ) ) ;END PROG (SETVAR "DIMLIM" 0)) ;; END IF (INITGET "S1 S2 T A U P S E L O ST D F M DF ?") )) ;; END PROGN END COND ( (= 1P "O")(PROGN (IF (= (GETVAR "DIMTOL") 0)(PROGN (SETVAR "DIMLIM" 0)(SETVAR "DIMTOL" 1) (SETVAR "DIMTFAC" 0.75) (INITGET "S1 S2 T A U P S E L O ST D F M DF ?") ); end progn (progn (SETVAR "DIMTOL" 0) (INITGET "S1 S2 T A U P S E L O ST D F M DF ?") )); end prog if )) ;; END PROGN END IF ( (= 1P "ST")(PROGN (IF (/= (SETQ TUP(GETSTRING (STRCAT "\n ENTER UPPER LIMIT <" (RTOS(GETVAR "DIMTP")) ">: ")) ) "")(SETVAR "DIMTP" (ATOF TUP)) ) (IF (/= (SETQ TUP(GETSTRING (STRCAT "\n ENTER LOWER LIMIT <" (RTOS(GETVAR "DIMTM")) ">: ")) ) "")(SETVAR "DIMTM" (ATOF TUP)) ) (INITGET "S1 S2 T A U P S E L O ST D F M DF ?") )) ;; END PROG END IF ( (= 1P "D")(PROGN (SETVAR "LUNITS" 2) (SETQ DIMUNIT 2) (INITGET "0 1 2 3 4 5") (IF (= (SETQ DPLC(GETSTRING "\n PLACE-0,1,2,3,4,5 <3>")) "") (SETVAR "LUPREC" 3) (SETVAR "LUPREC" (ATOI DPLC)) ) (SETQ DIMPREC (GETVAR "LUPREC")) ;(SETVAR "AUPREC" DIMPREC) (SETVAR "dimdec" dimprec) (SETVAR "dimtdec" dimprec) (INITGET "S1 S2 T A U P S E L O ST D F M DF ?"))) ( (= 1P "F")(PROGN (SETVAR "LUNITS" 5)(SETVAR "LUPREC" 5)(SETQ DIMUNIT 5)(SETQ DIMPREC 5) (INITGET "S1 S2 T A U P S E L O ST D F M DF ?"))) ( (= 1P "M")(PROGN (COMMAND "DIM" "TEDIT" PAUSE PAUSE "EXIT") (INITGET "S1 S2 T A U P S E L O ST D F M DF ?"))) ( (= 1P "DF")(PROGN(INITGET 1 "M I 1 T") (SETQ DPLC(GETKWORD "\n DIM FACTOR - etric/nch/<1>/ype# :")) (COND ( (= DPLC "M")(SETVAR "DIMLFAC" 25.4)) ( (= DPLC "I")(SETVAR "DIMLFAC" (/ 1.0 25.4))) ( (= DPLC "1")(SETVAR "DIMLFAC" 1)) ( (= DPLC "T")(SETVAR "DIMLFAC" (ATOF(GETSTRING "\n ENTER NEW DIM FACTOR: ")) ) )) (INITGET "S1 S2 T A U P S E L O ST D F M DF ?"))) ( (= 1P "?")(PROGN (C:DIMHELP) (INITGET "S1 S2 T A U P S E L O ST D F M DF ?"))) ( (= 1p nil)(progn (setq entd(entget(car(setq enth(entsel "\Select line, arc or circle: "))))) (IF (= (CDR(ASSOC 0 ENTD)) "LINE")(setq dx(strcat(rtos (abs(- (caddr(assoc 10 entd)) (caddr(assoc 11 entd)) ) ) 2) "\"") ) ; end setq dx ;; OTHERWISE (SETQ DX "") ) ; END IF LINE (setq 1p (cadr enth)) (INITGET "S1 S2 T A U P S E L O ST D F M DF") ) ) ;;END PROG nil END IF nil );END COND ) ; END WHILE 1P (IF (= ENTH nil) (progn(setq 2p (getpoint "\nSecond extension line origin: ")) (setq dx(strcat(rtos(abs(- (cadr 1p)(cadr 2p))) ) )) ) ) ;; END IF (setq dloc (getpoint "\nDimension line location: ")) ;(C:TOL) (setq dtxt (getstring (strcat "\nDimension text <" dx ">: ") )) (if (= dtxt nil)(setq dtxt dx)) (if(/= enth nil)(command "dim" "ver" "" enth dloc dtxt "exit") (command "dim" "ver" 1p 2p dloc dtxt "exit" "layer" "s" clyr "")) (setvar "LUNITS" OLDUNITS)(SETVAR "LUPREC" OLDLUPREC) (setq *error* herr)(setvar "CMDECHO" 1) (princ)) ;;;;*********************** (PRINC ".") ;;;;;;***************** (defun c:OR ()(setq herr *error* clyr (getvar "CLAYER") x ">: " 1p nil enth nil entd nil)(setvar "CMDECHO" 0) (SETQ OSMODEOLD (GETVAR "OSMODE")) (defun *error* (msg)(setq *error* herr)(command "layer" "s" clyr "") (setvar "LUNITS" OLDUNITS)(SETVAR "LUPREC" OLDLUPREC)(SETVAR "OSMODE" OSMODEOLD) (setvar "CMDECHO" 1)(princ)) (SETQ OLDUNITS(GETVAR "LUNITS"))(SETQ OLDLUPREC(GETVAR "LUPREC")) (SETQ ODLIM (GETVAR "DIMLIM"))(SETQ ODTOL (GETVAR "DIMTOL")) (SETVAR "LUNITS" DIMUNIT)(SETVAR "LUPREC" DIMPREC) (command "layer" "s" dimL "") (WHILE T (SETVAR "OSMODE" 37) (INITGET "T A U P S E L O ST D F M DF R ?") (WHILE (/= (TYPE 1p) 'list) (setq 1p(getpoint (STRCAT ; "\n " "\nDIM STYLE :<" (GETVAR "DIMSTYLE") "> S-set 0,0/Ext/Dec/Frac/Update/Move/ST-set tols/? <" (RTOS 24.14) (GETVAR "DIMPOST") "> " ; "\n S1 <" (ITOA(getvar "dimse1")) ; "> S2 <" (ITOA(getvar "dimse2")) "\n Text inside <" (ITOA(getvar "dimtix")) "> Align txt <" (ITOA(GETVAR "DIMTIH")) "> Limit <" (ITOA(GETVAR "DIMLIM")) "> tOls <" (ITOA(GETVAR "DIMTOL")) "> DF factor <" (RTOS(GETVAR "DIMLFAC")) "> Post txt <" (GETVAR "DIMPOST") "> " "\nSelect Feature: ") )) (COND ( (= 1P "T") (PROGN(SETVAR "DIMTIX" (- 1 (GETVAR "DIMTIX"))) (INITGET "T A U P S E L O ST D F M DF R ?")) ) ; END COND ( (= 1P "A")(PROGN (SETVAR "DIMTIH" (- 1 (GETVAR "DIMTIH"))) (SETVAR "DIMTOH" (GETVAR "DIMTIH"))(INITGET "T A U P S E L O ST D F M DF R ?"))) ( (= 1P "U")(PROGN (PRINC "\n ") (princ (STRCAT "\n PICK DIMENSION(s) TO UPDATE to 'current settings' - COLORS, UNITS, and/or STYLE <" (GETVAR "DIMSTYLE") "> ") ) (setq ssdim(ssget))(COMMAND "DIM")(SETQ I 0) (IF (= (SETQ ENTCLR(ITOA(GETVAR "DIMCLRD"))) "0")(SETQ ENTCLR "BYLAYER")) (WHILE (< I (SSLENGTH SSDIM))(IF (= (CDR (ASSOC 0 (ENTGET(SSNAME SSDIM I)) )) "DIMENSION") (COMMAND "UPD" (SSNAME SSDIM I) "") ;;; (COMMAND "RES" "" (SSNAME SSDIM I) "UPD" (SSNAME SSDIM I) "") (PROGN (IF (= (CDR (ASSOC 0 (setq uent(ENTGET(SSNAME SSDIM I))) )) "TEXT") (PROGN (COMMAND "EXIT") ;;; FOR TEXT (IF (/= (CDR(ASSOC 7 UENT)) "STANDARD")(PROGN (IF (= (CDR(ASSOC 72 UENT)) 5) (setq uent(subst (cons 72 0)(ASSOC 72 UENT) UENT)) ) (setq uent(subst (cons 7 "STANDARD")(ASSOC 7 UENT) UENT))(ENTMOD UENT) )) (COMMAND "CHANGE" (SSNAME SSDIM I) "" "" "" "" (* (GETVAR "DIMTXT")(GETVAR "DIMSCALE")) "" "" (STRCAT (CDR(ASSOC 1 (ENTGET (SSNAME SSDIM I)))) (GETVAR "DIMPOST")) ) (COMMAND "CHANGE" (SSNAME SSDIM I) "" "P" "C" "BYLAYER" "LA" TEXTL "" ) (COMMAND "DIM") );; END PROGN (PROGN (COMMAND "EXIT") ;;; CHANGE COLORS (COMMAND "CHANGE" (SSNAME SSDIM I) "" "P" "C" ENTCLR "LA" DIML "" ) (COMMAND "DIM") );; END PROGN ) ) ); END IF TEXT; END ELSE PROGN; END IF DIM (SETQ I(1+ I)) ) ; END WHILE (INITGET "T A U P S E L O ST D F M DF R ?")(COMMAND "EXIT") )) ;; END PROGN END COND U ( (= 1P "P")(PROGN (IF (= (SETQ PTXT(GETSTRING T "\n NEW POST TEXT ? : ")) "") (COMMAND "DIM" "DIMPOST" "." "EXIT")(COMMAND "DIM" "DIMPOST" (STRCAT "<> " PTXT) "EXIT")) (INITGET "T A U P S E L O ST D F M DF R ?") )) ;; END PROGN END COND ( (= 1P "R")(PROGN ; (COMMAND "DIM" "DIMPOST" "<> REF." "EXIT") (IF (= (TBLSEARCH "DIMSTYLE" "REF") nil) (PROGN (LOAD"DSTYLE")(C:DSTYLE))) (COMMAND "DIM" "RES" "REF" "EXIT") (INITGET "T A U P S E L O ST D F M DF R ?") )) ;; END PROGN END COND ( (= 1P "S")(PROGN (SETQ BPT(GETPOINT "\n SELECT 0,0 ORIGIN POINT: "))(COMMAND "UCS" "O" BPT) (INITGET "T A U P S E L O ST D F M DF R ?"))) ( (= 1P "E")(PROGN(SETVAR "DIMSE1" 0)(SETVAR "DIMSE2" 0) (INITGET "T A U P S E L O ST D F M DF R ?"))) ( (= 1P "L")(PROGN (IF (= (GETVAR "DIMLIM") 0)(PROGN (SETVAR "DIMTFAC" 1) (SETVAR "DIMLIM" 1)(SETVAR "DIMTOL" 0) (IF (/= (SETQ TUP(GETSTRING (STRCAT "\n ENTER UPPER LIMIT <" (RTOS(GETVAR "DIMTP")) ">: ")) ) "")(SETVAR "DIMTP" (ATOF TUP)) ) (IF (/= (SETQ TUP(GETSTRING (STRCAT "\n ENTER LOWER LIMIT <" (RTOS(GETVAR "DIMTM")) ">: ")) ) "")(SETVAR "DIMTM" (ATOF TUP)) ) ) ;END PROG (SETVAR "DIMLIM" 0)) ;; END IF (INITGET "T A U P S E L O ST D F M DF R ?") )) ;; END PROGN END COND ( (= 1P "O")(PROGN (IF (= (GETVAR "DIMTOL") 0)(PROGN (SETVAR "DIMLIM" 0)(SETVAR "DIMTOL" 1) (SETVAR "DIMTFAC" 0.75) (INITGET "S1 S2 T A U P S E L O ST D F M DF ?") ); end progn (progn (SETVAR "DIMTOL" 0) (INITGET "S1 S2 T A U P S E L O ST D F M DF ?") )); end prog if )) ;; END PROGN END IF ( (= 1P "ST")(PROGN (IF (/= (SETQ TUP(GETSTRING (STRCAT "\n ENTER UPPER LIMIT <" (RTOS(GETVAR "DIMTP")) ">: ")) ) "")(SETVAR "DIMTP" (ATOF TUP)) ) (IF (/= (SETQ TUP(GETSTRING (STRCAT "\n ENTER LOWER LIMIT <" (RTOS(GETVAR "DIMTM")) ">: ")) ) "")(SETVAR "DIMTM" (ATOF TUP)) ) (INITGET "S1 S2 T A U P S E L O ST D F M DF ?") )) ;; END PROG END IF ( (= 1P "D")(PROGN (SETVAR "LUNITS" 2) (SETQ DIMUNIT 2) (INITGET "0 1 2 3 4 5") (IF (= (SETQ DPLC(GETSTRING "\n PLACE-0,1,2,3,4,5 <3>")) "") (SETVAR "LUPREC" 3) (SETVAR "LUPREC" (ATOI DPLC)) ) (SETQ DIMPREC (GETVAR "LUPREC")) ;(SETVAR "AUPREC" DIMPREC) (SETVAR "dimdec" dimprec)(SETVAR "dimtdec" dimprec) (INITGET "T A U P S E L O ST D F M DF R ?"))) ( (= 1P "F")(PROGN (SETVAR "LUNITS" 5)(SETVAR "LUPREC" 5)(SETQ DIMUNIT 5)(SETQ DIMPREC 5) (INITGET "T A U P S E L O ST D F M DF R ?"))) ( (= 1P "M")(PROGN (COMMAND "DIM" "TEDIT" PAUSE PAUSE "EXIT") (INITGET "T A U P S E L O ST D F M DF R ?"))) ( (= 1P "DF")(PROGN(INITGET 1 "M I 1 T") (SETQ DPLC(GETKWORD "\n DIM FACTOR - etric/nch/<1>/ype# :")) (COND ( (= DPLC "M")(SETVAR "DIMLFAC" 25.4)) ( (= DPLC "I")(SETVAR "DIMLFAC" (/ 1.0 25.4))) ( (= DPLC "1")(SETVAR "DIMLFAC" 1)) ( (= DPLC "T")(SETVAR "DIMLFAC" (ATOF(GETSTRING "\n ENTER NEW DIM FACTOR: ")) ) )) (INITGET "T A U P S E L O ST D F M DF R ?"))) ( (= 1P "?")(PROGN (C:DIMHELP) (INITGET "T A U P S E L O ST D F M DF R ?"))) ( (= 1p nil)(^C) ) );END COND ) ; END WHILE 1P (SETVAR "OSMODE" 0) (setq 2p (getpoint 1p "\nLeader endpoint: ")) ; (setq dtxt (getstring "\nDimension text <" (princ dx) (princ x))) ; (if (= dtxt nil)(setq dtxt dx)) ;;************************ ;(IF (= (GETVAR "DIMPOST") "<> REF.")(SETVAR "DIMTOL" 0)(C:TOL) ) ;;************************ ;(C:TOL) (command "dim" "orD" 1p 2p "" "exit") ; ) ; (command "dim" "orD" 1p 2p "" "exit" "layer" "s" clyr "") ; ) (SETQ 1P nil) );END WHILE (setvar "LUNITS" OLDUNITS)(SETVAR "LUPREC" OLDLUPREC) (setq *error* herr)(setvar "CMDECHO" 1) (princ) ) ;;;;;;;;;;;;************; END OR (PRINC ".") ;;;************************************** (defun c:item () (setq iterr *error* ad 1 radi ( * 0.25 (getvar "dimscale")) clyr (getvar "clayer")) (setvar "cmdecho" 0)(defun *error* (msg) (command "layer" "s" clyr "") (setq *error* iterr)(setvar "cmdecho" 1)(princ)) (IF (= (SETQ ENTCLR(ITOA(GETVAR "DIMCLRD"))) "0")(SETQ ENTCLR "BYLAYER")) (command "layer" "s" dimL "")(initget 1 "A")(setq ldr1 (getpoint "\nAdd/: ")) (if (= (type ldr1) 'LIST)(progn(initget 1)(setq ldr2 (getpoint ldr1 "\nTo point: ")) (grdraw ldr1 ldr2 -1)(setq ldr3 (getpoint ldr2 "\nTo point: "))(if (= ldr3 nil) (progn(setq ang(angle ldr1 ldr2) dist(-(distance ldr1 ldr2) radi)) (command "dim1" "lea" ldr1 (polar ldr1 ang dist) ^c)(setq ldr3 ldr2)) (progn(setq ang(angle ldr2 ldr3) dist(-(distance ldr2 ldr3) radi)) (command "dim1" "lea" ldr1 ldr2 (polar ldr2 ang dist) ^c))) (command "circle" ldr3 radi)(command "change" "l" "" "p" "c" ENTCLR "") (command "layer" "s" TEXTL "") (initget 1)(setq c(getstring t "\nEnter item #: "))(command "text" "m" ldr3 (* (GETVAR "DIMSCALE") (GETVAR "DIMTXT") ) 0 c))) (if (= (strcase ldr1) "A")(progn(setq ldr3(cdr(assoc 10(entget(car(entsel "\npick existing balloon: ")))))) (setq dir(getangle ldr3 "\nDirection for balloon: ")) (if (and (<= dir 2.35) (>= dir 0.78))(setq ldr3 (list (car ldr3) (+ (cadr ldr3) (* 2 radi))))) (if (and (< dir 3.92) (> dir 2.35))(setq ldr3 (list (- (car ldr3) (* 2 radi)) (cadr ldr3)))) (if (and (<= dir 5.49) (>= dir 3.92))(setq ldr3 (list (car ldr3) (- (cadr ldr3) (* 2 radi))))) (if (or (< dir 0.78) (> dir 5.49))(setq ldr3 (list (+ (car ldr3) (* 2 radi)) (cadr ldr3)))) (command "layer" "s" dimL "")(command "circle" ldr3 radi)(command "change" "l" "" "p" "c" ENTCLR "") (command "layer" "s" TEXTL "") (setq c(getstring t "\nEnter item #: "))(command "text" "m" ldr3 (* (GETVAR "DIMSCALE")(GETVAR "DIMTXT")) 0 c))) (while ad(setq ad "") ;;;;(getstring "\nAdd adjacent balloon: ") ) (if (OR (= AD "") (= (strcase ad) "Y")) (progn(setq dir(getangle ldr3 "\nDirection for balloon: ")) (if (and (<= dir 2.35) (>= dir 0.78))(setq ldr3 (list (car ldr3) (+ (cadr ldr3) (* 2 radi))))) (if (and (< dir 3.92) (> dir 2.35))(setq ldr3 (list (- (car ldr3) (* 2 radi)) (cadr ldr3)))) (if (and (<= dir 5.49) (>= dir 3.92))(setq ldr3 (list (car ldr3) (- (cadr ldr3) (* 2 radi))))) (if (or (< dir 0.78) (> dir 5.49))(setq ldr3 (list (+ (car ldr3) (* 2 radi)) (cadr ldr3)))) (command "layer" "s" dimL "")(command "circle" ldr3 radi)(command "change" "l" "" "p" "c" ENTCLR "") (setq c(getstring t "\nEnter item #: ")) (command "layer" "s" TEXTL "")(command "text" "m" ldr3 (* (GETVAR "DIMSCALE")(GETVAR "DIMTXT")) "0" c)) (setq ad nil))) (command "layer" "s" clyr "")(setq *error* iterr)(setvar "cmdecho" 1) (princ)) ;;;***************************************** (PRINC ".") ;;;;;;**************** (DEFUN C:DU()(SETVAR "CMDECHO" 0) ;;;;;;******** ERROR HANDLING (setq MDerr *error*) (Defun *error* (msg)(setq *error* MDerr) (setvar "LUNITS" OLDUNITS)(SETVAR "LUPREC" OLDLUPREC) (PRINC (STRCAT "\nVERSION : " MDVER)) (PRINC (STRCAT "\nCURRENT STYLE : " (GETVAR "DIMSTYLE") )) (setvar "cmdecho" 1)(princ)) ;;;;;;;******** END ERROR (IF (= MDSWAP nil)(PROGN (SETQ DSPUNIT OLDUNITS)(SETQ DSPPREC OLDLUPREC))) ;;;;;;**************** DISPLAY UNITS (PRINC "\nSELECT TYPE OF UNITS USED FOR DISPLAY")(INITGET "2 4 5 S") (IF (= (SETQ MDASK(GETKWORD (STRCAT "\n (2)-decimal (4)-arch (5)-fractional (S)wap units <" (ITOA OLDUNITS) "> : ")) ) nil) (SETQ OLDUNITS OLDUNITS) (IF (= MDASK "S")(IF (= MDSWAP nil) (PROGN (SETQ OLDUNITS DIMUNIT)(SETQ OLDLUPREC DIMPREC)(SETQ MDSWAP 1)(^C) ) (PROGN (SETQ OLDUNITS DSPUNIT)(SETQ OLDLUPREC DSPPREC)(SETQ MDSWAP nil)(^C) ) );; END PROG END IF (SETQ OLDUNITS (ATOI MDASK)) ) ; END IF S );END IF (PRINC "\nSELECT PRECISION FOR DISPLAY") (IF (= OLDUNITS 2)(PROGN (INITGET "0 1 2 3 4 5") (IF (= (SETQ MDASK(GETKWORD (STRCAT "\n (1) - .0 (3) - .000 (5) - .00000 \n (2) - .00 (4) - .0000 Default <" (ITOA OLDLUPREC) "> : ")) ) nil) (SETQ OLDLUPREC OLDLUPREC) (SETQ OLDLUPREC (ATOI MDASK)) ));END IF END PROG ;; OTHERWISE (PROGN (PRINC "\n PICK SMALLEST DENOMINATOR TO USE ") (INITGET "0 1 2 3 4 5 6") (IF (= (SETQ MDASK(GETKWORD (STRCAT "\n (1)-1/2 (3)-1/8 (5)-1/32 \n (2)-1/4 (4)-1/16 Default-<" (ITOA OLDLUPREC) "> : ")) ) nil) (SETQ OLDLUPREC OLDLUPREC) (SETQ OLDLUPREC (ATOI MDASK)) ));END IF END PROG ) ;; END IF ;;***************** END OF DISPLAY UNITS ;;;;;*************** DIMUNITS (PRINC "\nSELECT TYPE OF UNITS USED FOR DIMENSIONING")(INITGET "2 4 5 S") (IF (= (SETQ MDASK(GETKWORD (STRCAT "\n (2)-decimal (4)-arch (5)-fractional (S)ame as display units Default:<" (ITOA DIMUNIT) "> : ")) ) nil) (SETQ DIMUNIT DIMUNIT) (IF (= MDASK "S")(PROGN (SETQ DIMUNIT OLDUNITS)(SETQ DIMPREC OLDLUPREC)(^C) ) (SETQ DIMUNIT (ATOI MDASK)) ); END IF 'S' );END IF (PRINC "\nSELECT PRECISION FOR DIMENSIONING") (IF (= DIMUNIT 2)(PROGN (INITGET "0 1 2 3 4 5") (IF (= (SETQ MDASK(GETKWORD (STRCAT "\n (1) - .0 (3) - .000 (5) - .00000 \n (2) - .00 (4) - .0000 Default <" (ITOA DIMPREC) "> : ")) ) nil) (SETQ DIMPREC DIMPREC) (SETQ DIMPREC (ATOI MDASK)) ));END IF END PROG ;; OTHERWISE (PROGN (PRINC "\n PICK SMALLEST DENOMINATOR TO USE ") (INITGET "1 2 3 4 5 6") (IF (= (SETQ MDASK(GETKWORD (STRCAT "\n (1)-1/2 (3)-1/8 (5)-1/32 \n (2)-1/4 (4)-1/16 Default-<" (ITOA DIMPREC) "> : ")) ) nil) (SETQ DIMPREC DIMPREC) (SETQ DIMPREC(ATOI MDASK)) ));END IF END PROG ) ;; END IF ;;;;;;**************** END OF DIM UNITS (SETQ DSPUNIT OLDUNITS)(SETQ DSPPREC OLDLUPREC) (SETVAR "LUNITS" OLDUNITS)(SETVAR "LUPREC" OLDLUPREC) (setq *error* MDerr) (PRINC) ) ;; END FUNCTION ;;***************** (PRINC ".") ;;;********************************** (DEFUN C:SM() (SETVAR "CMDECHO" 0)(PRINC "\n PICK INSERTION: ") (COMMAND "INSERT" "SMARK" "NEAR" PAUSE DSCALE "" "") (SETVAR "CMDECHO" 1)(PRINC) ) ;;***************** (PRINC ".") ;;;********************************** (SETQ MYTEXT (STRCAT MYTEXT "\n DIMENSION COMMANDS:" "\n , -horizontal, -vertical, -item, " "\n -set units, -surface mark " "\n" )) (PRINC "\n NEW COMMANDS: 'MD', 'H'-horizontal, 'V'-vertical, 'I'-item, ") (PRINC "\n 'DU'-set units 'SM'-surface mark ") (PRINC)