CADXY坐標標注AUTOLISP程序

1、CAD XW標標注AUTO LIS醒序;(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 nINVALID POINT, PICK !)(SETQ X NIL)(SETQ PXX (CAR P)PYY (CADR P)PX(RTO

2、S PXX 2 PRE1)PY(RTOS PYY 2 PRE1);(DEFUN MAX_XY(WI PX PY / L PX PY)(DEFUN MAX_XY ()(SETQ LLL Y)(SETQ LX (STRLEN PX)LY (STRLEN PY)(IF ( LX LY)(PROGN(SETQ W_NU (- LX LY)(WHILE ( W_NU 0)(SETQ PY (STRCAT PY)(SETQ W_NU (- W_NU 1)(IF ( W_NU 0)(SETQ PX (STRCAT PX)(SETQ W_NU (- W_NU 1)(SETQ PY (STRCAT KKK PY

3、)(SETQ PX (STRCAT LLL PX)(SETQ PXL(STRLEN PX)PYL(STRLEN PY)MAXL (FLOAT (MAX PXL PYL)L(* WI MAXL);(DEFUN TEXT_P(/ W WX WY)(DEFUN TEXT_P ()(SETVAR 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 AL0

4、1 (+ PI CAL)(SETQ ALPW (ANGLE P W)(SETQ AG-D (- ALPW CAL)(IF ( AG-D 0)(PROGN(IF (AND ( AG-D (* PI 0)(SETQ WE (POLAR W CAL L)BZ 1)(IF (AND ( AG-D (* PI0.5) ( AG-D (* PI1.5) ()(PROGN; AG-D (* PI -0.5) ( AG-D (* PI 0)(SETQ WE (POLAR W CAL L)BZ 1)(IF (AND ( AG-D (* PI -1.5)(SETQ WE (POLAR W AL01 L)BZ 2)

5、(IF (AND ( AG-D (* PI -2)(SETQ WE (POLAR W CAL L)BZ 3);)(COMMAND PLINE P W0.0 W WE );(DEFUN DRCORD(AL01 ALPW H CAL PX PY /)(DEFUN DRCORD ()(IF (= BZ 2)(SETQ WB WE)(SETQ WB W)(SETQ WBX (POLAR WB (+ (* PI0.5) CAL) H)WBY (POLAR WB (+ (* PI1.5) CAL) H)(SETQ AL_CAL (* 180 (/ CAL PI)(COMMAND TEXT J ML WBX

6、 H AL_CAL PY)(COMMAND TEXT J ML WBY H AL_CAL PX);(DEFUN DRELEV(AL01 ALPW WE CAL WI PRE2)(DEFUN DRELEV ()(IF ( WX PXX)(SETQ EPL (POLAR WE AL01 (* WI0.5)(SETQ EPR (POLAR WE CAL (* WI0.5)(SETQ DHH (GETREAL nINPUT DESIGN ELEVATION:)(IF (= DHH NIL)(PROMPT nNO ELEVATION AVAILABLE NOW!)(PROGN(SETQ DH (RTOS

7、 DHH 2 PRE2)(SETQ CLA (GETVAR 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 TS0.0)(SETVAR 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)

8、(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 POINT(ENTER=END SELECT

9、:)(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)(SETVAR OSMODE 0)(INITGE

10、T 1)(SETQ W (GETPOINT nINPUT TEXT POSITION:)(COMMAND TEXT W H0.0 (STRCAT S= TSS)(DEFUN ETP ()(SETQ X T)(WHILE X(PROMPT nSELECT EDGE OF THE POLYGON:)(SETQ S_SET (SSGET)(IF(= S_SET NIL)(PROMPT nINVALID SELECTION, RESELECT PLEASE!)(SETQ X NIL)(CA_AREA)(DEFUN LTP ()(INITGET 1)(SETQ URC (GETCORNER(SETQ D

11、LC (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 POLYLINE)(COMMAND PEDIT (SSGET P10) J SSET X)(T (PROMPT nINVALID ENTITY FOR PEDIT!)(DEFUN RETP ()(SETQ SET1 (SSGET P10)(SETQ ENAME (SSNAM

12、E 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 nITS A CLOSED POLYLINE)(S)(PROGN(REDRAW ENAME 3)(PROMPT nITS NOT A CLOSED PLINE, TRY TO CLOSE IT!)(LTP)(RETP)(PLTP)(IF (=

13、ENTP2 1)(PROGN (PROMPT nNOW IT HAS BEEN CLOSED!)(S)(PROGN (REDRAW ENAME 3)(SETQ X(GETSTRING(STRCATnCANT BE CLOSED AUTOMATICALLY, CALCULATE IST AREA?n)(IF (OR (= X Y) (= X y)(S)(PROMPT nTHIS ONE IGNORED, CALCULATE NEXT POLYGON!)(DEFUN S ()(COMMAND AREA E (SSGET P10)(SETQ SS (GETVAR AREA)(SETQ S1 (RTO

14、S SS 2 PRE3)(SETVAR OSMODE 0)(INITGET 1)(SETQ PT (GETPOINT nINPUT TEXT POSITION:)(COMMAND TEXT PT H0.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/)(IF (= B NIL)(SETQ B B0)(SETQ B0 B)(PROGN(INITGET 7)(SETQ B

15、 (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/)(IF (= CAL2 NIL)(SETQ CAL (/ (* PI CAL0) 180)(PROGN(SETQ CAL (/ (* PI CAL2) 180)(SETQ CAL0 CAL2)(PROGN (INITGET 8)(SETQ CAL2 (GETREA

16、L 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/)(IF (= HH NIL)(SETQ HH HH0)(SETQ HH0 HH)(PROGN (INITGET 7)(SETQ HH (GETREAL nINPUT TEXT HEIGHT MM:)(SETQ HH0 HH)(SETQ H (

17、* HH B)(IF (= WF NIL)(SETQ WF1.0)(SETQ WI (* H WF)(DEFUN PRE1N ()(IF (/= PRE10 NIL)(PROGN (SETQ PRE1I (RTOS PRE10 2 0)(INITGET 4)(SETQPRE1 (GETINT(STRCAT nINPUT DECIMAL PLACE FOR X-Y COORDINATE :)(IF (= PRE1 NIL)(SETQ PRE1 PRE10)(SETQ PRE10 PRE1)(PROGN (INITGET 5)(SETQ PRE1(GETINT nINPUT DECIMAL PLA

18、CE FOR X-Y COORDINATE:)(SETQ PRE10 PRE1)(DEFUN PRE2N ()(IF (/= PRE20 NIL)(PROGN (SETQ PRE2I (RTOS PRE20 2 0)(INITGET 4)(SETQ PRE2 (GETINT(STRCATnINPUT DECIMAL PLACE FOR ELEVATION :)(IF (= PRE2 NIL)(SETQ PRE2 PRE20)(SETQ PRE20 PRE2)(PROGN (INITGET 5)(SETQ PRE2(GETINT nINPUT DECIMAL PLACE FOR ELEVATIO

19、N:)(SETQ PRE20 PRE2)(DEFUN PRE3N ()(IF (/= PRE30 NIL)(PROGN (SETQ PRE3I (RTOS PRE30 2 0)(INITGET 4)(SETQ PRE3(GETINT(STRCAT nINPUT DECIMAL PLACE FOR AREA IDENTIFICATION :)(IF (= PRE3 NIL)(SETQ PRE3 PRE30)(SETQ PRE30 PRE3)(PROGN (INITGET 5)(SETQ PRE3(GETINT nINPUT DECIMAL PLACE FOR AREA IDENTIFICATIO

20、N:)(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 (GETVAR CLAYER)(IF (/= CLA CORD)(XYLA)(IDPT);(TEXT_P);(MAX_X

21、Y WI PX PY L)(MAX_XY);(DRLIN CAL P W L)(DRLIN);(DRCORD AL01 ALPW H CAL PX PY)(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/COnti

22、nue/CHangepar?/)(COND(= ZZ Help)(TEXTPAGE)(PROMPTnENTERAVALUEORAPOINTTODEFINETHELENGTHOFOBLIQUAL BASELINE AND)(PROMPTnENTERAPOINTINONEOFTHEFOURQAUDRANTSTOSELECTTHEDIRECTIONOF THE )(PROMPTnOBLIQUALBASELINEORPRESSENTERTOSELECTTHEDEFAULTVALUES.)(= ZZ Exit)(PROMPT nEXIT TO MAIN SELECTIONS)(SETQ XXNILXX2

23、 NIL)(PRINC)(OR (= ZZ NIL) (= ZZ Continue)(SETQ CLA (GETVAR 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?/)(CON

24、D(= ZZ Help)(TEXTPAGE)(PROMPTnFIRST 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)(SETVAR OSMODE 1)(SETQ PP (GETPOINT nSELECT THE ID POINT:)(SETQ P (OSNAP PP END)(SETQ PXX (C

25、AR P)(SETQ X T)(WHILE X(SETQ WEE (GETPOINT nINPUT THE TEXT POSITION:)(SETQ WE (OSNAP WEE END)(IF (= WE NIL)(PROMPT nINVALID POSITION, RESELECT PLEASE!)(SETQ X NIL)(SETQ WX (CAR WE)(SETVAR OSMODE 0)(DE)(DEFUN PLGS ()(SETQ CLA (GETVAR CLAYER)(IF (/= CLA AREA)(SLA)(THN)(PRE3N)(ETP)(SETVAR osmode 0)(INI

26、TGET 1)(SETQ PT (GETPOINT n Please input TEXT POSITION:)(COMMAND textPTH0.0(STRCAT S= S_AREA)(DEFUN CA_AREA ()(SETQ ENT_NAME (SSNAME S_SET 0)(SETQ ENT_NUM (SSLENGTH S_SET)(SETQ T_AREA 0LOOP 0NUM 0)(WHILE LOOP(COMMAND AREA E ENT_NAME)(SETQ S1_AREA (LIST (GETVAR AREA)(SETQ S2_AREA (CAR S1_AREA)(SETQ T

27、_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 (GETVAR CLAYER)(IF (/= CLA AREA)(SLA)(THN)(PRE3N)(SETQ L_NAME (GETSTRING nPlaese input LAYER NAME:)(SETQ S_SET (SSGET X(LIST (CONS

28、0 POLYLINE)(CONS 8 L_NAME)(CA_AREA)(SETVAR osmode 0)(INITGET 1)(SETQ PT (GETPOINT n Please input TEXT POSITION:)(COMMAND textPTH0.0(STRCAT The layerS= S_AREA)(DEFUN E_COLOR ()(SETQ CLA (GETVAR CLAYER)(IF (/= CLA AREA)(SLA)(THN)(PRE3N)(SETQ C_NAME (GETINT nPlaese input COLOR NAME:)(SETQ S_SET (SSGET

29、X(LIST (CONS 0 POLYLINE)(CONS 62 C_NAME)(CA_AREA)(SETVAR osmode 0)(INITGET 1)(SETQ PT (GETPOINT n Please input TEXT POSITION:)(COMMAND textPTH0.0(STRCAT The color S= S_AREA)(DEFUN POS ()(SETQ CLA (GETVAR CLAYER)(IF (/= CLA AREA)(SLA)(THN)(PRE3N)(SETQ XX T)(WHILE XX(INITGET Help Exit Continue)(SETQ Z

30、Z (GETKWORD nHelp/Exit/Continue?/)(COND(= ZZ Help)(TEXTPAGE)(PROMPTnENTER THE POINTS TO DEFINE THE EDGE OF THE REGION)(PROMPTnTO BE CALCULATED AND IDed, AFTER LAST POINT ENTERED,)(PROMPTnPRESS ENTER AND THEN SELECT A POINT TO DEFINE THE)(PROMPT nPOSITION OF THE AREA ID TEXT.)(= ZZ Exit)(PROMPT nEXIT

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

32、OBLIQUAL LINE LENGTH DRAWING UNIT/:)(SETQ ALL (GETDIST P)(IF (= ALL NIL)(SETQ ALL AL0)(SETQ AL0 ALL)(PROGN (INITGET 71)nINPUT OBLIQUAL LINE LENGTH DRAWING UNIT)(SETQ AL0 ALL)(IF (/= WA0 NIL)(PROGN(SETQ WAI (ANGTOS WA0 0 0)(PROMPT(STRCATnCHOOSE THE DIRECTION OF THE OBLIQUAL LINE:)(SETQ DRL (GETANGLE

33、P)(IF (= DRL NIL)(SETQ WA WA0)(PROGN(COND( DRL (* PI0.5)(SETQ WA (* PI0.25)( DRL PI)(SETQ WA (* PI0.75)( DRL (* PI)(SETQ WA (* PI)( DRL (* PI2.0)(SETQ WA (* PI)(SETQ WA0 WA)(PROGN (INITGET 1)(SETQDRL (GETANGLE PnCHOOSE THE DIRECTION OF THE OBLIQUAL LINE:)(COND( DRL (* PI0.5)(SETQ WA (* PI0.25)( DRL

34、PI)(SETQ WA (* PI0.75)( DRL (* PI(SETQ WA (* PI)( DRL (* PI2.0)(SETQ WA (* PI)(SETQ WA0 WA)(DEFUN ALN2 ()(SETQ W (POLAR P (+ CAL WA) ALL)(SETQ WX (CAR W)(DEFUN TSET ()(SETVAR FILEDIA 0)(SETQ WFF (GETREALnINPUT THE WIDTH-HEIGHT FACTOR OF TEXT:)(IF (= WFF NIL)(SETQ WF1.0)(SETQ WF WFF)(COMMAND STYLE ST

35、ANDARD MONOTXT0.0 WF 0 N N N)(SETVAR 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:)(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:)(SETQ DS (GETREAL)(IF (= DS NIL)(SETQ DS DS0)(