LISP经典程序.doc

;一、绘制地形图符号 1.点状符号对于点状符号,其位置固定,数量较多,且一般都带有一定的标注,可逐个制作属性块图元,单独插入。 2.线状符号利用AutoCAD中强大的线型定义。 3.面状符号由充填符号在面域内按一定的排列方式组合而成。目前Auto CAD在建筑设计、工程施工放样得到广泛应用, Auto CAD在工程测量上的应用,大大减少手算坐标的工程量或帮助人们复核手算坐标的准确性。(1)删除未选择对象(defun c:sd() (princn选择要保留对象:) (setq SS(ssget) ss1(ssgetX) (commanderasess1rsszoom _e);end;(2)画圆弧型铁路;输入铁路中线上三个点，轨距及绘图比例尺，起、中、始点(defun c:ytl() (setvar osmode 0);取消扑捉 (setq PB(getpointn输入起点：) (setq PM(getpointn输入中点：) (setq PE(getpointn输入终点：) (setq WD(getrealn输入铁路宽度(m)：) (setq S(getrealn绘图比例尺=：);1:1000,输入1.0 (setq W1(/(* WD S) 2) W2(+ W1(* 0.6 S);轨道及枕木符号的半宽 (setq D(distance PB PE) (setq A1(angle PB PM) A2(angle PB PE) A3(angle PE PB) A4(angle PE PM) (setq FB(- A1 A2) FE(- A3 A4) P12(* PI 2) (if ( FB 0)(setq FB(+ FB P12);求 PB和PE点的圆周角 (if ( FE 0)(setq FE(+ FE P12) (setq F(+ FB FE) R(/ D(* (sin F)2);求全弧所对圆心角之半，圆弧半径 (setq F1(- (/ PI 2) F) ABC(- A2 F1) (if ( ABC 0) (setq ABC(+ ABC P12) (setq C(polar PB ABC R);求圆心之点位 (setq ACB(angle C PB) ABC(angle PB C);起点左右垂直于中线切线的方位角 (setq ACM(angle C PM) AMC(angle PM C);中点左右垂直于中线切线的方位角 (setq ACE(angle C PE) AEC(angle PE C);终点左右垂直于中线切线的方位角 (setq PBL(polar PB ACB W1) PBL1(polar PB ACB W2) (setq PBR(polar PB ABC W1) PBR1(polar PB ABC W2) (setq PML(polar PM ACM W1) PMR(polar PM AMC W1) (setq PEL(polar PE ACE W1) PER(polar PE AEC W1) (setq S2(* 0.2 S) S4(* 0.4 S) S10(* 10 S) (command pline PBL w S2 S2 A S PML PEL );画左右铁路连线 (command pline PBR w S2 S2 A S PMR PER ) (command pline PBL1 w S4 S4 PBR1 );画起点处枕木 (setq DF(/(* 10 S) R);求一个分段圆弧所对圆心角 (setq FF 0);动态分段圆弧之和，所对圆心角初值赋0 (while( FF(* F 2) (command pline PL W S4 S4 PR );画分段处枕木 (setq FF(+ FF DF) (setq ACP(- ACB FF) P(polar c ACP R) (setq APC(angle P C)PL(polar P ACP W2) PR(polar P APC W2) ) (PRINC);END;(3)弧度化度分秒函数;如0.356弧度化为20.2350,即202350(defun dfm(hdj) (setq jd(/(* hdj 180) pi) (setq du(fix jd);截去小数,提取度数 (setq f1(* 60 (- jd du) (setq ff( fix f1);截去小数,提取分数 (setq mm(rtos(* 60 (- f1 ff) 2 0);按四舍五入提取秒数 ;上面的du,ff是整型数,mm是字符串 (setq du(itoa du) ff(itoa ff);把du,ff转化为字符串 (if (strlen ff) 2);求ff长度(setq ff(strcat 0 ff);如果ff长度小于2，执行此表达式(setq ff ff);如果ff长度等于2，执行此表达式 ) (if (strlen mm) 2);求mm长度(setq mm(strcat 0 mm);如果mm长度小于2，执行此表达式(setq mm mm);如果mm长度等于2，执行此表达式 ) (setq jd(strcat du . ff mm);把度，小数点,分,秒放在一个字符串中) ;end;(4)度分秒化成弧度(defun hhd(a) ;按(hhd 6.3628)调用 (setq a(rtos a 2 4) ;a转换为字符型 (setq ws(strlen a) ;求角度a的长度，即判断度数的位数 (setq ad (substr a 1 (- ws 5) ;根据度数的位数取数给ad (setq am (substr a (- ws 3) 2) ;根据度数的位数取数给am (setq as (substr a (- ws 1) 2) ;根据度数的位数取数给as (setq a1 (atof ad) ;把ad转换为实数 (setq a2 (atof am) ;把am转换为实数 (setq a3 (atof as) ;把as转换为实数 (setq ar (+ a1 (/ a2 60) (/ a3 3600) (setq ard (/ (* ar pi) 180) (setq a ard);end;(5)标注面积（平方米和亩） (defun c:mj() (setq os (getvar osmode);osmode是捕捉系统变量 (setq cmd (getvar cmdecho);CMDECHO是系统变量 (setvar osmode 0) (setvar cmdecho 0) (setq p1 (getpoint n请在要标注封闭区域内点一下:) (command -boundary p1 );构建多段线边界 (setq bj (entlast);获得边界（bj）图元名称 (command area o bj);获得边界（bj）图元名称面积 (entdel bj);删除边界（bj）图元名称 (setq mj (rtos (getvar area) 2 3) (setq area1 (strcat mj fSimSun|b0|i0|c134|p2;平方米 () (setq ans (* (/ (atof area1) 10000.0) 15.0) (setq ans (rtos ans 2 3) (setq area2 (strcat area1 ans fSimSun|b0|i0|c134|p2;亩) (entmake (list (0 . MTEXT) (100 . AcDbEntity) (100 . AcDbMText) (cons 10 p1) (cons 40 5) (cons 41 0) (cons 71 0) (cons 50 0) (72 . 5) (cons 1 area2) ) );创建一个新图元 (setvar osmode os) (setvar cmdecho cmd) (princ);end;(6)对单行文字修改主程序(DEFUN C:GWZ() (princ nselect object:) (setq s (ssget) (GJD);调用修改文字角度函数 (GGD);调用修改文字高度函数);结束(defun GJD();修改文字角度函数 (setq hig (getreal n输入角度:) (if (= hig nil) (setq hig 0.0) (setq hig (* pi hig) hig (/ hig 180.0) (setq h50 (cons 50 hig) (setq n (sslength s) (setq k 0 ) (while ( k n) (setq name (ssname s k) (setq a (entget name) (setq b (assoc 0 a) (setq b (cdr b) (if (= b TEXT)(progn (setq h (assoc 50 a) (setq a (subst h50 h a) (entmod a) ) (setq k (+ k 1) );结束(DEFUN GGD ();修改文字高度函数 (setq hig (getreal n输入新字高:) (if (= hig nil) (setq hig 3.0) (setq h40 (cons 40 hig) (setq n (sslength