CAD XY坐标标注AUTO LISP程序.doc

《CAD XY坐标标注AUTO LISP程序.doc》由会员分享，可在线阅读，更多相关《CAD XY坐标标注AUTO LISP程序.doc（22页珍藏版）》请在淘文阁 - 分享文档赚钱的网站上搜索。

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 nINVALID POINT, PICK !) (SETQ X NIL) ) ) (SETQPXX (CAR

2、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) (SETQLX (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

3、(STRCAT PX)(SETQ W_NU (- W_NU 1) ) ) ) (SETQ PYPY (STRCAT KKK PY) (SETQ PXPX (STRCAT LLL PX) (SETQPXL (STRLEN PXPX)PYL (STRLEN PYPY)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 (C

4、AR 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)(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

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

6、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 (POL

7、AR WE CAL (* WI 0.5) ) (SETQ DHH (GETREAL nINPUT DESIGN ELEVATION:) (IF (= DHH NIL) (PROMPT nNO ELEVATION AVAILABLE NOW!) (PROGN (SETQ DH (RTOS 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) ) ) )(DEF

8、UN PCR () (SETQ TS 0.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) (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

9、 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:) (SETQ P2 (GETPOINT PRO_1) (IF(/= P2 NIL) (PROGN (SETQ SS (* (+ (CADR P1) (CADR P2) (- (CAR P2) (CAR P1) 0.5) ) (S

10、ETQ 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) (INITGET 1) (SETQ W (GETPOINT nINPUT TEXT POSITION:) (COMMAND TEXT W H 0.0 (STRCAT S= TSS)(DEFU

11、N 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) (SETQURC (GETCORNER (SETQ DLC (GETPOINT nENTER FIRST CORNER:) nTHE SECOND CORNER: ) ) (SETQ SSET (

12、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 (SSNAME SET1 0) (SETQ ELIST (ENTGET ENAME) (SETQ ENTP (CDR

13、 (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 (= ENTP2 1)(PROGN (PROMPT nNOW IT HAS

14、BEEN CLOSED!) (S)(PROGN (REDRAW ENAME 3) (SETQ X (GETSTRING(STRCAT nCANT 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 (RTOS SS 2 PRE3)

15、 (SETVAR 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 (GETREAL (STRCAT nINPUT MAP SCALE FACTOR 1:X*1000/) ) ) (IF (= B NIL)(SETQ B B0)(SETQ B0 B) ) ) (PROGN (INITGET

16、 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 CAL (/ (* PI CAL0) 180)(PROGN (SETQ CAL (/ (* PI CAL2) 180) (SETQ CAL0 CAL2) ) ) (P

17、ROGN (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 NIL)(SETQ HH HH0)(SETQ HH0 HH) ) ) (PROGN (INITGET 7) (SETQ

18、 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 (STRCAT nINPUT DECIMAL PLACE FOR X-Y COORDINATE : ) ) ) (IF (= PRE1 NIL) (SETQ

19、 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 ELEVATION :) ) ) (IF (= PRE2

20、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 (STRCAT nINPUT DECIMAL PLACE FOR AREA IDENTIFICATION :

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

22、Z 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_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

23、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 VALUE OR A POINT TO DEFINE TH

24、E 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 VALUES. )(= ZZ Exit) (PROMPT nEXIT TO MAIN SELECTIONS) (SETQ XX NIL XX2 NIL ) (PRINC)(OR (= ZZ NIL) (= ZZ Continue)

25、 (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?/) (COND (= ZZ Help)

26、 (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) (SETVAR OSMODE 1) (SETQ PP (GETPOINT nSELECT THE ID POINT:) (SETQ P (OSNAP PP END) (SETQ

27、 PXX (CAR 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)

28、 (PRE3N) (ETP) (SETVAR osmode 0) (INITGET 1) (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) (SETQT_AREA 0LOOP 0NUM 0 ) (WHILE LOOP (COMMAND AREA E ENT_NAME) (SETQ S1_AREA (L

29、IST (GETVAR 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 (GETVAR CLAYER) (IF (/= CLA AREA) (SLA) ) (THN) (PRE3N) (SETQ L_NAME

30、 (GETSTRING nPlaese input LAYER NAME:) (SETQS_SET (SSGET X (LIST (CONS 0 POLYLINE) (CONS 8 L_NAME) ) ) ) (CA_AREA) (SETVAR osmode 0) (INITGET 1) (SETQ PT (GETPOINT n Please input TEXT POSITION:) (COMMAND text PT H 0.0 (STRCAT The layerS= S_AREA) )(DEFUN E_COLOR () (SETQ CLA (GETVAR CLAYER) (IF (/= C

31、LA AREA) (SLA) ) (THN) (PRE3N) (SETQ C_NAME (GETINT nPlaese input COLOR NAME:) (SETQS_SET (SSGET 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 text PT H 0.0 (STRCAT The color S= S_AREA) )(DEFUN POS

32、() (SETQ CLA (GETVAR 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

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

34、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) ) ) (PROGN (INITGET 71) (SETQ ALL (GETDIST P nINPUT OBLIQUAL LINE LENGTH DRAWING UNIT ) ) (SETQ AL0 ALL) ) ) (IF (/= WA0 NIL) (PROGN (SETQ WAI (ANGTOS WA0 0 0) (PROMPT(STRCAT