2019年整理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 ALID POINT, PICK !)(SETQ X NIL)(SETQ PXX (CAR P)PYY (CA

2、DR 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_NU 0)(SETQ PY (STRCAT PY)(SETQ W_NU (- W_NU 1)(IF ( W_NU 0)(SETQ PX (STRCAT PX) (SETQ W_NU (

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

4、LIN(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) (SETQ WE (POLAR W CAL L)BZ 1)(IF (AND ( AG-D (* PI 0.5) ( AG-D (* PI 1.5) ()(PROGN; AG-D (* PI -0.5) ( AG-D (* PI 0) (SETQ WE (POLAR W CAL L)BZ 1)(IF (

5、AND ( AG-D (* PI -1.5) (SETQ WE (POLAR W AL01 L)BZ 2)(IF (AND ( 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

6、) 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 ATION:)(IF

7、(= 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 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 (GE

8、TPOINT 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(S

9、ETQ P_NUMBER (+ 1 P_NUMBER)(SETQ PRO_1 (STRCAT n THE 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

10、)(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, RE

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

12、)(T (PROMPT nINV ALID 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 nITS A CLOSED POL YLINE)(S)(

13、PROGN(REDRAW ENAME 3)(PROMPT nITS 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(STRCATnCANT BE CLOSED AUTOMA TICALL Y, CALCULATE IST AREA?n)(IF (OR (= X Y) (= X y)(S)YGON!)(PROMPT nTHIS ONE IGN

14、ORED, 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 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 (GETRE

15、AL(STRCAT nINPUT MAP SCALE FACTOR 1:X*1000/) )(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 ANGLEd/) )(IF (= CAL2 NIL)(SETQ

16、CAL (/ (* PI CAL0) 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/)(IF (= HH

17、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 (GETINT(STRCA T nINPUT DECIMAL PLACE FOR X-Y COO

18、RDINATE :)(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(STRCATnINPUT DECIMAL PLACE FOR ELEV ATION :)

19、(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 ()(IF (/= PRE30 NIL)(PROGN (SETQ PRE3I (RTOS PRE30 2 0)(INITGET 4)(SETQ PRE3 (GETINT(STRCA T nINPUT DECIMAL PLACE FOR AREA IDENTIFICATION :)(IF (=

20、 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 SELECTI

21、ONS)(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)(

22、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)(PROMPTOFn ENTER A VALUE OR A POINT TO DEFINE THE LENGTH OBLIQUAL BASELINE AND(PROMPTnENTER A POINT IN ONE OF THE FOUR QAUDRANTS T

23、O SELECT THE DIRECTION OF THE )(PROMPTnOBLIQUAL BASELINE OR PRESS ENTER TO SELECT THE DEFAULT VALUES.)(= ZZ Exit)(PROMPT nEXIT TO MAIN SELECTIONS)(SETQ XX NILXX2 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)

24、(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?/)(COND(= ZZ Help)(TEXTPAGE)(PROMPTnFIRST SELECT THE ID POINT, THEN SELECT THE END OF THE)(PROMPT nHORIZONTAL BASELINE;)(= ZZ Exit)(PROMPT nEXIT

25、 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 (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, RES

26、ELECT 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 Please input TEXT POSITION:) (COMMAND textPTH0.0(STRCAT S= S_AREA)(DEFUN CA_AREA ()(SETQ ENT_NAME (SSNAME S

27、_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_

28、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 textP

29、TH0.0(STRCAT The layerS= 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 T

30、EXT POSITION:) (COMMAND textPTH0.0(STRCAT The color 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)(PROMPTnENTER THE POINTS TO DEFINE THE EDG

31、E 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 TO MAIN SELECTIONS)(SETQ XX NIL)(PRINC)(OR (= ZZ NIL) (= ZZ Continue)(PCR)(DEFUN XYLA ()(COMMAND LAYE

32、R 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/:)(SETQ ALL (GETDIST P)(IF (= ALL NIL)(SETQ ALL AL0)(SETQ AL0 ALL)(P

33、ROGN (INITGET 71)(SETQ ALL (GETDIST PnINPUT OBLIQUAL LINE LENGTH DRAWING UNIT )(SETQ AL0 ALL)(IF (/= WA0 NIL)(PROGN(SETQ WAI (ANGTOS W A0 0 0)(PROMPT(STRCATnCHOOSE THE DIRECTION OF THE OBLIQUAL LINE:)(SETQ DRL (GETANGLE P)(IF (= DRL NIL)(SETQ WA WA0)(PROGN(COND( DRL (* PI 0.5)(SETQ WA (* PI 0.25)( D

34、RL 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 PnCHOOSE 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)

35、( 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 (GETREALnINPUT THE WIDTH-HEIGHT FACTOR OF TEXT: )(IF (= WFF NIL)(SETQ WF 1.0)(SETQ WF WFF)(COMMAND STYLE STANDARD MONOTXT0.0 WF 0 N N N)(SETV AR F

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