CADXY坐标标注AUTOLISP程序

1、CAD X,Y 坐标坐标标注 AUTO LISP 程序; (DEFUN IDPT(/ p px py pxx pyy)(DEFUN IDPT ()(SETQ X T)(WHILE X(SETVAR "OSMODE" (+ 1 32 512)(INITGET 1)(SETQ PP (GETPOINT "nPLEASE PICK THE POINT:")(SETVAR "OSMODE" 0)(SETQ P (OSNAP PP "INT,END,CEN")(IF (= P NIL)(PROMPT "nINV A

2、LID 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)LY (STRLEN PY)(IF (> LX L Y)(PROGN(SETQ W_NU (- LX L Y)(WHILE (> W_

3、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

4、) 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 CA

5、L)(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;<

6、;<<<<(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 "

7、;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&qu

8、ot; "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 ATIO

9、N:")(IF (= DHH NIL)(PROMPT "nNO ELEV ATION A VAILABLE 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

10、" "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?

11、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

12、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)(S

13、ETQ 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

14、 (= 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") (

15、= 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 RET

16、P ()(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 &quo

17、t;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 OTH

18、ER KEY FOR NO>")(IF (OR (= X "Y") (= X "y")(S)YGON!")(PROMPT "nTHIS ONE IGNORED, CALCULATE NEXT POL )(DEFUN S ()(COMMAND "AREA" "E" (SSGET P10)(SETQ SS (GETV AR "AREA")(SETQ S1 (RTOS SS 2 PRE3)(SETV AR "OSMODE" 0)(INITGET

19、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)(SETQB (GETREAL(STRCAT "nINPUT MAP SCALE FACTOR 1:X*1000/<" BI ">") )(IF (= B NIL)(SETQ B

20、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 ANGLEd/<" CAL1 ">") )(IF (= CAL2 NIL)(SETQ CAL (/ (* PI CAL0

21、) 180)(PROGN(SETQ CAL (/ (* PI CAL2) 180)(SETQ CAL0 CAL2)(PROGN (INITGET 8)(SETQ CAL2 (GETREAL "nINPUT TEXT ROTATE ANGLEd:") (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/<"

22、 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)(SETQPRE1 (GET

23、INT(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 P

24、RE2I (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 ELEVATION:")(SETQ PRE20 PRE2)(DEFUN PRE3N ()

25、(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 I

26、DENTIFICATION:")(SETQ PRE30 PRE3)(DEFUN XYZ ()(THN)(PRE1N)(PRE2N)(SETQ XX T)(WHILE XX(INITGET "Exit Continue")(SETQ ZZ (GETKWORD "nExit/Continue?/<Continue>") (COND(= ZZ "Exit")(PROMPT "nEXIT TO MAIN SELECTIONS")(SETQ XX NIL)(PRINC)(OR (= ZZ NIL) (=

27、 ZZ "Continue")(SETQ CLA (GETV AR "CLAYER")(IF (/= CLA "CORD")(XYLA)(IDPT)J J(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)(WH

28、ILE XX2(SETQ XX3 NIL)(IDPT)(ALN1)(SETQ XX T)(WHILE XX(INITGET "Help Exit COntinue CHangepar")(SETQ ZZ (GETKWORD "nHelp/Exit/COntinue/CHangepar?/<COntinue>")(COND(= ZZ "Help")(TEXTPAGE)(PROMPTOF"n ENTER A VALUE OR A POINT TO DEFINE THE LENGTH OBLIQUAL BASELINE

29、 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 VALUES.")(= ZZ "Exit")(PROMPT "nEXIT TO MAIN SELECTIONS")(SETQ XX NILXX2 NIL)(PRINC)(OR (=

30、 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")(S

31、ETQ ZZ (GETKWORD "nHelp/Exit/Continue?/<Continue>")(COND(= ZZ "Help")(TEXTPAGE)(PROMPT"nFIRST SELECT THE ID POINT, THEN SELECT THE END OF THE")(PROMPT "nHORIZONTAL BASELINE;")(= ZZ "Exit")(PROMPT "nEXIT TO MAIN SELECTIONS")(SETQ XX NI

32、L)(PRINC)(OR (= ZZ NIL) (= ZZ "Continue")(SETVAR "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

33、(= WE NIL)(PROMPT "nINV ALID POSITION, RESELECT PLEASE!")(SETQ X NIL)(SETQ WX (CAR WE)(SETVAR "OSMODE" 0)(DE)(DEFUN PLGS ()(SETQ CLA (GETV AR "CLAYER")(IF (/= CLA "AREA")(SLA)(THN)(PRE3N)(ETP)(SETV AR "osmode" 0)(INITGET 1)(SETQ PT (GETPOINT "n

34、Please input TEXT POSITION:") (COMMAND "text"PTH0.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 "ARE

35、A")(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 (

36、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"PTH0.0(STRCAT "The layer<

37、;" 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_

38、AREA)(SETV AR "osmode" 0)(INITGET 1)(SETQ PT (GETPOINT "n Please input TEXT POSITION:") (COMMAND "text"PTH0.0(STRCAT "The color <" (RTOS C_NAME 2 0) ">S=" S_AREA) )(DEFUN POS ()(SETQ CLA (GETV AR "CLAYER")(IF (/= CLA "AREA")

39、(SLA) ) (THN) (PRE3N) (SETQ XX T) (WHILE XX(INITGET "Help Exit Continue")(SETQ ZZ (GETKWORD "nHelp/Exit/Continue?/<Continue>")(COND(= ZZ "Help")(TEXTPAGE)(PROMPT"nENTER THE POINTS TO DEFINE THE EDGE OF THE REGION")(PROMPT"nTO BE CALCULATED AND IDed,

40、 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)(

41、DEFUN XYLA ()(COMMAND "LAYER" "M" "CORD" "C" "CYAN" "" "")(DEFUN ELA ()(COMMAND "LAYER" "M" "ELEV" "C" "CYAN" "" "")(DEFUN SLA ()(COMMAND "LAYER" &quo

42、t;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 AL

43、0)(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 N

44、IL)(SETQ WA WA0)(PROGN(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)(PROGN (INITGET 1)(SETQDRL (GETANGLE P"nCHOOSE THE DIRECTION OF THE OBLIQUAL LINE:" )(COND(< D

45、RL (* 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

46、 WIDTH-HEIGHT FACTOR OF TEXT<1.0>:" )(IF (= WFF NIL)(SETQ WF 1.0)(SETQ WF WFF)(COMMAND "STYLE" "STANDARD" "MONOTXT""0.0" WF "0" "N" "N" "N")(SETV AR "FILEDIA" 1)(COMMAND "COLOR" "BYLAY

47、ER")(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

48、(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 FAC