CAD XY坐标标注AUTO LISP程序
CAD X,Y坐标坐标标注AUTO LISP程序
;; (DEFUN IDPT(/ p px py pxx pyy)
(DEFUN IDPT ()
(SETQ X T)
(WHILE X
(SETV AR "OSMODE" (+ 1 32 512))
(INITGET 1)
(SETQ PP (GETPOINT "\nPLEASE PICK THE POINT:")) (SETV AR "OSMODE" 0)
(SETQ P (OSNAP PP "INT,END,CEN"))
(IF (= P NIL)
(PROMPT "\nINV ALID POINT, PICK !")
(SETQ X NIL)
)
)
(SETQ PXX (CAR P)
PYY (CADR P)
PX (RTOS PXX 2 PRE1)
PY (RTOS PYY 2 PRE1)
)
)
;;(DEFUN MAX_XY(WI PX PY / L PXPX PYPY) (DEFUN MAX_XY ()
(SETQ KKK "X")
(SETQ LLL "Y")
(SETQ LX (STRLEN PX)
L Y (STRLEN PY)
)
(IF (> LX L Y)
(PROGN
(SETQ W_NU (- LX L Y))
(WHILE (> W_NU 0)
(SETQ PY (STRCAT " " PY))
(SETQ W_NU (- W_NU 1))
)
)
)
(IF (< LX L Y)
(PROGN
(SETQ W_NU (- L Y LX))
(WHILE (> W_NU 0)
(SETQ PX (STRCAT " " PX))
(SETQ W_NU (- W_NU 1))
)
)
)
(SETQ PYPY (STRCAT KKK PY))
(SETQ PXPX (STRCAT LLL PX))
(SETQ PXL (STRLEN PXPX)
PYL (STRLEN PYPY)
MAXL (FLOAT (MAX PXL PYL))
L (* WI MAXL)
)
)
;;(DEFUN TEXT_P(/ W WX WY)
(DEFUN TEXT_P ()
(SETV AR "OSMODE" 0)
(INITGET 1)
(SETQ W (GETPOINT "\nINPUT X-Y TEXT POSITION:")) (SETQ WX (CAR W))
(SETQ WY (CADR W))
)
;;(DEFUN DRLIN(CAL P W L / ALPW WE)
(DEFUN DRLIN ()
(SETQ AL01 (+ PI CAL))
(SETQ ALPW (ANGLE P W))
(SETQ AG-D (- ALPW CAL))
(IF (> AG-D 0)
(PROGN
(IF (AND (< AG-D (* PI 0.5)) (> AG-D (* PI 0))) (SETQ WE (POLAR W CAL L)
BZ 1
)
)
(IF (AND (> AG-D (* PI 0.5)) (< AG-D (* PI 1.5))) (SETQ WE (POLAR W AL01 L)
BZ 2
)
)
(IF (AND (> AG-D (* PI 1.5)) (< AG-D (* PI 2))) (SETQ WE (POLAR W CAL L)
BZ 3
)
)
;>>>>>
)
(PROGN
;<<<<<
(IF (AND (> AG-D (* PI -0.5)) (< AG-D (* PI 0))) (SETQ WE (POLAR W CAL L)
BZ 1
)
)
(IF (AND (< AG-D (* PI -0.5)) (> AG-D (* PI -1.5))) (SETQ WE (POLAR W AL01 L)
BZ 2
)
)
(IF (AND (< AG-D (* PI 1.5)) (> AG-D (* PI -2))) (SETQ WE (POLAR W CAL L)
BZ 3
)
)
;>>>>>
)
)
(COMMAND "PLINE" P "W" 0.0 "" W WE "")
)
;;(DEFUN DRCORD(AL01 ALPW H CAL PXPX PYPY /)
(DEFUN DRCORD ()
(IF (= BZ 2)
(SETQ WB WE)
(SETQ WB W)
)
(SETQ WBX (POLAR WB (+ (* PI 0.5) CAL) H)
WBY (POLAR WB (+ (* PI 1.5) CAL) H)
)
(SETQ AL_CAL (* 180 (/ CAL PI)))
(COMMAND "TEXT" "J" "ML" WBX H AL_CAL PYPY) (COMMAND "TEXT" "J" "ML" WBY H AL_CAL PXPX)
)
;;(DEFUN DRELEV(AL01 ALPW WE CAL WI PRE2)
(DEFUN DRELEV ()
(IF (< WX PXX)
(SETQ EPL (POLAR WE AL01 (* WI 0.5)))
(SETQ EPR (POLAR WE CAL (* WI 0.5)))
)
(SETQ DHH (GETREAL "\nINPUT DESIGN ELEV A TION:"))
(IF (= DHH NIL)
(PROMPT "\nNO ELEV ATION A V AILABLE NOW!")
(PROGN
(SETQ DH (RTOS DHH 2 PRE2))
(SETQ CLA (GETV AR "CLAYER"))
(IF (/= CLA "ELEV")
(ELA)
)
(IF (< WX PXX)
(COMMAND "TEXT" "J" "MR" EPL H AL_CAL DH)
(COMMAND "TEXT" "J" "ML" EPR H AL_CAL DH)
)
)
)
)
(DEFUN PCR ()
(SETQ TS 0.0)
(SETV AR "OSMODE" 33)
(SETQ X T)
(WHILE X
(INITGET 1)
(SETQ PP1 (GETPOINT "\nENTER THE FIRST POINT:"))
(SETQ P1 (OSNAP PP1 "INT,END"))
(IF (/= P1 NIL)
(SETQ X NIL)
(PROGN (PROMPT "\nNO INT OR END FOUND, CONTINUE? [Y/N]") (INITGET 1)
(SETQ J (GETSTRING))
(IF (OR (= J "Y") (= J "y"))
(PROGN (SETQ P1 PP1) (SETQ X NIL))
(PROMPT "\nRESELECT PLEASE!")
)
)
)
)
(SETQ OP1 P1)
(SETQ P_NUMBER 1)
(SETQ X T)
(WHILE X
(SETQ P_NUMBER (+ 1 P_NUMBER))
(SETQ PRO_1 (STRCAT "\n THE <" (ITOA P_NUMBER)))
(SETQ PRO_1 (STRCAT PRO_1 "> POINT(ENTER=END SELECT:)"))
(SETQ P2 (GETPOINT PRO_1))
(IF (/= P2 NIL)
(PROGN (SETQ SS
(* (+ (CADR P1) (CADR P2)) (- (CAR P2) (CAR P1)) 0.5) )
(SETQ TS (+ TS SS))
(SETQ P1 P2)
)
(PROGN (SETQ SS
(* (+ (CADR OP1) (CADR P1)) (- (CAR OP1) (CAR P1)) 0.5) )
(SETQ TS (+ TS SS))
(SETQ X NIL)
)
)
)
(SETQ S0 (ABS TS))
(SETQ TSS (RTOS S0 2 PRE3))
(SETV AR "OSMODE" 0)
(INITGET 1)
(SETQ W (GETPOINT "\nINPUT TEXT POSITION:"))
(COMMAND "TEXT" W H 0.0 (STRCAT "S=" TSS))
)
(DEFUN ETP ()
(SETQ X T)
(WHILE X
(PROMPT "\nSELECT EDGE OF THE POL YGON:")
(SETQ S_SET (SSGET))
(IF (= S_SET NIL)
(PROMPT "\nINV ALID SELECTION, RESELECT PLEASE!")
(SETQ X NIL)
)
)
(CA_AREA)
)
(DEFUN LTP ()
(INITGET 1)
(SETQ URC (GETCORNER
(SETQ DLC (GETPOINT "\nENTER FIRST CORNER:"))
"\nTHE SECOND CORNER:"
)
)
(SETQ SSET (SSGET "W" DLC URC))
(COND
((OR (= ENTP "LINE") (= ENTP "ARC"))
(COMMAND "PEDIT" (SSGET P10) "Y" "J" SSET "" "X")
)
((= ENTP "POL YLINE")
(COMMAND "PEDIT" (SSGET P10) "J" SSET "" "X")
)
(T (PROMPT "\nINVALID ENTITY FOR PEDIT!"))
)
)
(DEFUN RETP ()
(SETQ SET1 (SSGET P10))
(SETQ ENAME (SSNAME SET1 0))
(SETQ ELIST (ENTGET ENAME))
(SETQ ENTP (CDR (ASSOC 0 ELIST)))
)
(DEFUN PLTP ()
(SETQ ENTP2 (CDR (ASSOC 70 ELIST)))
)
(DEFUN PLS ()
(PLTP)
(IF (= ENTP2 1)
(PROGN (REDRAW ENAME 3)
(PROMPT "\nIT'S A CLOSED POL YLINE")
(S)
)
(PROGN
(REDRAW ENAME 3)
(PROMPT "\nIT'S NOT A CLOSED PLINE, TRY TO CLOSE IT!")
(LTP)
(RETP)
(PLTP)
(IF (= ENTP2 1)
(PROGN (PROMPT "\nNOW IT HAS BEEN CLOSED!")
(S)
)
(PROGN (REDRAW ENAME 3)
(SETQ X
(GETSTRING
(STRCAT
"\nCAN'T BE CLOSED AUTOMA TICALL Y, CALCULATE IST AREA?"
"\n<'Y' FOR YES AND ANY OTHER KEY FOR NO>"
)
)
)
(IF (OR (= X "Y") (= X "y"))
(S)
(PROMPT "\nTHIS ONE IGNORED, CALCULATE NEXT POL YGON!")
)
)
)
)
)
)
(DEFUN S ()
(COMMAND "AREA" "E" (SSGET P10))
(SETQ SS (GETV AR "AREA"))
(SETQ S1 (RTOS SS 2 PRE3))
(SETV AR "OSMODE" 0)
(INITGET 1)
(SETQ PT (GETPOINT "\nINPUT TEXT POSITION:"))
(COMMAND "TEXT" PT H 0.0 (STRCAT "S=" S1))
)
(DEFUN THN ()
(IF (/= B0 NIL)
(PROGN
(SETQ BI (RTOS B0 2 1))
(INITGET 6)
(SETQ
B (GETREAL
(STRCAT "\nINPUT MAP SCALE FACTOR [1:X*1000]/<" BI ">")
)
)
(IF (= B NIL)
(SETQ B B0)
(SETQ B0 B)
)
)
(PROGN
(INITGET 7)
(SETQ B (GETREAL "\nINPUT MAP SCALE FACTOR [1:X*1000]"))
(SETQ B0 B)
)
)
(IF (/= CAL0 NIL)
(PROGN
(SETQ CAL1 (RTOS CAL0 2 1))
(INITGET 8)
(SETQ CAL2 (GETREAL
(STRCAT "\nINPUT TEXT ROTATE ANGLE[d]/<" CAL1 ">")
)
)
(IF (= CAL2 NIL)
(SETQ CAL (/ (* PI CAL0) 180))
(PROGN
(SETQ CAL (/ (* PI CAL2) 180))
(SETQ CAL0 CAL2)
)
)
)
(PROGN (INITGET 8)
(SETQ CAL2 (GETREAL "\nINPUT TEXT ROTATE ANGLE[d]:"))
(SETQ CAL (/ (* PI CAL2) 180))
(SETQ CAL0 CAL2)
)
)
(IF (/= HH0 NIL)
(PROGN
(SETQ HHI (RTOS HH0 2 1))
(INITGET 6)
(SETQ HH (GETREAL
(STRCAT "\nINPUT TEXT HEIGHT [mm]/<" HHI ">")
)
)
(IF (= HH NIL)
(SETQ HH HH0)
(SETQ HH0 HH)
)
)
(PROGN (INITGET 7)
(SETQ HH (GETREAL "\nINPUT TEXT HEIGHT [MM]:"))
(SETQ HH0 HH)
)
)
(SETQ H (* HH B))
(IF (= WF NIL)
(SETQ WF 1.0)
)
(SETQ WI (* H WF))
)
(DEFUN PRE1N ()
(IF (/= PRE10 NIL)
(PROGN (SETQ PRE1I (RTOS PRE10 2 0))
(INITGET 4)
(SETQ
PRE1 (GETINT
(STRCA T "\nINPUT DECIMAL PLACE FOR X-Y COORDINATE <"
PRE1I
">:"
)
)
)
(IF (= PRE1 NIL)
(SETQ PRE1 PRE10)
(SETQ PRE10 PRE1)
)
)
(PROGN (INITGET 5)
(SETQ PRE1
(GETINT "\nINPUT DECIMAL PLACE FOR X-Y COORDINATE:") )
(SETQ PRE10 PRE1)
)
)
)
(DEFUN PRE2N ()
(IF (/= PRE20 NIL)
(PROGN (SETQ PRE2I (RTOS PRE20 2 0))
(INITGET 4)
(SETQ PRE2 (GETINT
(STRCAT "\nINPUT DECIMAL PLACE FOR ELEV ATION <"
PRE2I
">:"
)
)
)
(IF (= PRE2 NIL)
(SETQ PRE2 PRE20)
(SETQ PRE20 PRE2)
)
)
(PROGN (INITGET 5)
(SETQ PRE2
(GETINT "\nINPUT DECIMAL PLACE FOR ELEV A TION:")
)
(SETQ PRE20 PRE2)
)
)
)
(DEFUN PRE3N ()
(IF (/= PRE30 NIL)
(PROGN (SETQ PRE3I (RTOS PRE30 2 0))
(INITGET 4)
(SETQ PRE3
(GETINT
(STRCA T "\nINPUT DECIMAL PLACE FOR AREA IDENTIFICATION <"
PRE3I
">:"
)
)
)
(IF (= PRE3 NIL)
(SETQ PRE3 PRE30)
(SETQ PRE30 PRE3)
)
)
(PROGN (INITGET 5)
(SETQ PRE3
(GETINT "\nINPUT DECIMAL PLACE FOR AREA IDENTIFICATION:") )
(SETQ PRE30 PRE3)
)
)
)
(DEFUN XYZ ()
(THN)
(PRE1N)
(PRE2N)
(SETQ XX T)
(WHILE XX
(INITGET "Exit Continue")
(SETQ ZZ (GETKWORD "\nExit/Continue?/
(COND
((= ZZ "Exit")
(PROMPT "\nEXIT TO MAIN SELECTIONS")
(SETQ XX NIL)
(PRINC)
)
((OR (= ZZ NIL) (= ZZ "Continue"))
(SETQ CLA (GETV AR "CLAYER"))
(IF (/= CLA "CORD")
(XYLA)
)
(IDPT)
;;
(TEXT_P)
;; (MAX_XY WI PX PY L)
(MAX_XY)
;; (DRLIN CAL P W L)
(DRLIN)
;; (DRCORD AL01 ALPW H CAL PXPX PYPY)
(DRCORD)
;; (DRELEV AL01 ALPW WE CAL WI PRE2)
(DRELEV)
)
)
)
)
(DEFUN FIX ()
(THN)
(PRE1N)
(PRE2N)
(SETQ XX2 T)
(WHILE XX2
(SETQ XX3 NIL)
(IDPT)
(ALN1)
(SETQ XX T)
(WHILE XX
(INITGET "Help Exit COntinue CHangepar")
(SETQ ZZ (GETKWORD "\nHelp/Exit/COntinue/CHangepar?/
(COND
((= ZZ "Help")
(TEXTPAGE)
(PROMPT
"\n ENTER A V ALUE OR A POINT TO DEFINE THE LENGTH OF OBLIQUAL BASELINE AND"
)
(PROMPT
"\nENTER A POINT IN ONE OF THE FOUR QAUDRANTS TO SELECT THE DIRECTION OF THE "
)
(PROMPT
"\nOBLIQUAL BASELINE OR PRESS 'ENTER' TO SELECT THE DEFAULT V ALUES."
)
)
((= ZZ "Exit")
(PROMPT "\nEXIT TO MAIN SELECTIONS")
(SETQ XX NIL
XX2 NIL
)
(PRINC)
)
((OR (= ZZ NIL) (= ZZ "Continue"))
(SETQ CLA (GETV AR "CLAYER"))
(IF (/= CLA "CORD")
(XYLA)
)
(IF (= XX3 T)
(IDPT)
)
(SETQ XX3 T)
(CPXY)
(ALN2)
(TBL)
(CORD)
(DE)
)
((= ZZ "CHangepar") (SETQ XX NIL))
)
)
)
)
(DEFUN AE ()
(ELA)
(THN)
(PRE2N)
(SETQ XX T)
(WHILE XX
(INITGET "Help Exit Continue")
(SETQ ZZ (GETKWORD "\nHelp/Exit/Continue?/
((= ZZ "Help")
(TEXTPAGE)
(PROMPT
"\n FIRST SELECT THE ID POINT, THEN SELECT THE END OF THE"
)
(PROMPT "\nHORIZONTAL BASELINE;")
)
((= ZZ "Exit")
(PROMPT "\nEXIT TO MAIN SELECTIONS")
(SETQ XX NIL)
(PRINC)
)
((OR (= ZZ NIL) (= ZZ "Continue"))
(SETV AR "OSMODE" 1)
(SETQ PP (GETPOINT "\nSELECT THE ID POINT:"))
(SETQ P (OSNAP PP "END"))
(SETQ PXX (CAR P))
(SETQ X T)
(WHILE X
(SETQ WEE (GETPOINT "\nINPUT THE TEXT POSITION:"))
(SETQ WE (OSNAP WEE "END"))
(IF (= WE NIL)
(PROMPT "\nINV ALID POSITION, RESELECT PLEASE!")
(SETQ X NIL)
)
)
(SETQ WX (CAR WE))
(SETV AR "OSMODE" 0)
(DE)
)
)
)
)
(DEFUN PLGS ()
(SETQ CLA (GETV AR "CLAYER"))
(IF (/= CLA "AREA")
(SLA)
)
(THN)
(PRE3N)
(ETP)
(SETV AR "osmode" 0)
(SETQ PT (GETPOINT "\n Please input TEXT POSITION:")) (COMMAND "text"
PT
H
0.0
(STRCAT "S=" S_AREA)
)
)
(DEFUN CA_AREA ()
(SETQ ENT_NAME (SSNAME S_SET 0))
(SETQ ENT_NUM (SSLENGTH S_SET))
(SETQ T_AREA 0
LOOP 0
NUM 0
)
(WHILE LOOP
(COMMAND "AREA" "E" ENT_NAME)
(SETQ S1_AREA (LIST (GETV AR "AREA")))
(SETQ S2_AREA (CAR S1_AREA))
(SETQ T_AREA (+ T_AREA S2_AREA))
(SETQ NUM (+ NUM 1))
(SETQ ENT_NAME (SSNAME S_SET NUM))
(IF (= NUM ENT_NUM)
(SETQ LOOP NIL)
)
)
(SETQ S_AREA (RTOS T_AREA 2 PRE3))
)
(DEFUN E_LAYER ()
(SETQ CLA (GETV AR "CLAYER"))
(IF (/= CLA "AREA")
(SLA)
)
(THN)
(PRE3N)
(SETQ L_NAME (GETSTRING "\nPlaese input LAYER NAME:")) (SETQ S_SET (SSGET "X"
(LIST (CONS 0 "POL YLINE")
(CONS 8 L_NAME)
)
)
)
(CA_AREA)
(SETV AR "osmode" 0)
(INITGET 1)
(SETQ PT (GETPOINT "\n Please input TEXT POSITION:")) (COMMAND "text"
PT
H
0.0
(STRCAT "The layer<" L_NAME ">S=" S_AREA)
)
)
(DEFUN E_COLOR ()
(SETQ CLA (GETV AR "CLAYER"))
(IF (/= CLA "AREA")
(SLA)
)
(THN)
(PRE3N)
(SETQ C_NAME (GETINT "\nPlaese input COLOR NAME:")) (SETQ S_SET (SSGET "X"
(LIST (CONS 0 "POL YLINE")
(CONS 62 C_NAME)
)
)
)
(CA_AREA)
(SETV AR "osmode" 0)
(INITGET 1)
(SETQ PT (GETPOINT "\n Please input TEXT POSITION:")) (COMMAND "text"
PT
H
0.0
(STRCAT "The color <" (RTOS C_NAME 2 0) ">S=" S_AREA) )
)
(DEFUN POS ()
(SETQ CLA (GETV AR "CLAYER"))
(IF (/= CLA "AREA")
(SLA)
)
(THN)
(PRE3N)
(SETQ XX T)
(WHILE XX
(INITGET "Help Exit Continue")
(SETQ ZZ (GETKWORD "\nHelp/Exit/Continue?/
(COND
((= ZZ "Help")
(TEXTPAGE)
(PROMPT
"\n ENTER THE POINTS TO DEFINE THE EDGE OF THE REGION"
)
(PROMPT
"\nTO BE CALCULATED AND IDed, AFTER LAST POINT ENTERED,"
)
(PROMPT
"\nPRESS 'ENTER' AND THEN SELECT A POINT TO DEFINE THE"
)
(PROMPT "\nPOSITION OF THE AREA ID TEXT.")
)
((= ZZ "Exit")
(PROMPT "\nEXIT TO MAIN SELECTIONS")
(SETQ XX NIL)
(PRINC)
)
((OR (= ZZ NIL) (= ZZ "Continue"))
(PCR)
)
)
)
)
(DEFUN XYLA ()
(COMMAND "LAYER" "M" "CORD" "C" "CYAN" "" "")
)
(DEFUN ELA ()
(COMMAND "LAYER" "M" "ELEV" "C" "CYAN" "" "")
)
(DEFUN SLA ()
(COMMAND "LAYER" "M" "AREA" "C" "CYAN" "" "")
)
(DEFUN ALN1 ()
(IF (/= AL0 NIL)
(PROGN (SETQ ALI (RTOS AL0 2 1))
(INITGET 70)
(PROMPT
(STRCAT "\nINPUT OBLIQUAL LINE LENGTH [DRAWING UNIT]/<"
ALI
">:"
)
)
(SETQ ALL (GETDIST P))
(IF (= ALL NIL)
(SETQ ALL AL0)
(SETQ AL0 ALL)
)
)
(PROGN (INITGET 71)
(SETQ ALL (GETDIST P
"\nINPUT OBLIQUAL LINE LENGTH [DRAWING UNIT]"
)
)
(SETQ AL0 ALL)
)
)
(IF (/= WA0 NIL)
(PROGN
(SETQ WAI (ANGTOS W A0 0 0))
(PROMPT
(STRCAT "\nCHOOSE THE DIRECTION OF THE OBLIQUAL LINE<"
WAI
"d>:"
)
)
(SETQ DRL (GETANGLE P))
(IF (= DRL NIL)
(SETQ W A WA0)
(PROGN
(COND
((< DRL (* PI 0.5))
(SETQ W A (* PI 0.25))
)
((< DRL PI)
(SETQ W A (* PI 0.75))
)
((< DRL (* PI 1.5))
(SETQ W A (* PI 1.25))
)
((< DRL (* PI 2.0))
(SETQ W A (* PI 1.75))
)
)
)
)
)
(PROGN (INITGET 1)
(SETQ
DRL (GETANGLE P
"\nCHOOSE THE DIRECTION OF THE OBLIQUAL LINE:"
)
)
(COND
((< DRL (* PI 0.5))
(SETQ WA (* PI 0.25))
)
((< DRL PI)
(SETQ WA (* PI 0.75))
)
((< DRL (* PI 1.5))
(SETQ WA (* PI 1.25))
)
((< DRL (* PI 2.0))
(SETQ WA (* PI 1.75))
)
)
(SETQ WA0 WA)
)
)
)
(DEFUN ALN2 ()
(SETQ W (POLAR P (+ CAL WA) ALL))
(SETQ WX (CAR W))
)
(DEFUN TSET ()
(SETV AR "FILEDIA" 0)
(SETQ WFF (GETREAL
"\nINPUT THE WIDTH-HEIGHT FACTOR OF TEXT<1.0>:"
)
)
(IF (= WFF NIL)
(SETQ WF 1.0)
)
(COMMAND "STYLE" "STANDARD" "MONOTXT" "0.0" WF "0" "N" "N" "N") (SETV AR "FILEDIA" 1)
(COMMAND "COLOR" "BYLAYER")
(PRINC)
)
(DEFUN CO-ZOOM ()
(PROMPT "\nTURN OFF ALL UNCONCERN LAYERS!")
(IF (/= CS0 NIL)
(PROGN (SETQ CSI (RTOS CS0 2 1))
(INITGET 6)
(PROMPT (STRCAT "\nINPUT CURRENT SCALE FACTOR<" CSI ">:"))
(SETQ CS (GETREAL))
(IF (= CS NIL)
(SETQ CS CS0)
(SETQ CS0 CS)
)
)
(PROGN (SETQ CS (GETREAL "\nINPUT CURRENT SCALE FACTOR:")) (SETQ CS0 CS)
)
)
(IF (/= DS0 NIL)
(PROGN (SETQ DSI (RTOS DS0 2 1))
(INITGET 6)
(PROMPT (STRCAT "\nINPUT PREFER SCALE FACTOR<" DSI ">:"))
(SETQ DS (GETREAL))
(IF (= DS NIL)
(SETQ DS DS0)
(SETQ DS0 DS)
)
)
(PROGN (SETQ DS (GETREAL "\nINPUT PREFER SCALE FACTOR:")) (SETQ DS0 DS)
)
)
(SETQ FTOR (/ DS CS))
(SETQ XX T)
(WHILE XX
(INITGET "Help Exit Continue")
(SETQ ZZ (GETKWORD "\nHelp/Exit/Continue?/
(COND