LISP經(jīng)典程序

1、; ;一 、 繪 制 地 形 圖符號1.點(diǎn)狀符號對于點(diǎn)狀符號 ,其位置固定 , 數(shù)量較多 ,且一般都帶有一定的標(biāo)注 ,可逐個制作屬性塊圖元2.線狀符號利用 AutoCAD 中強(qiáng)大的線型定義。3.面狀符號 由充填符號在面域內(nèi)按一定的排列方式組合而成。目前 Auto CAD 在建筑設(shè)計、工程施工放樣得到廣泛應(yīng)用，Auto CAD 在工程測量上的應(yīng)用坐標(biāo)的工程量或幫助人們復(fù)核手算坐標(biāo)的準(zhǔn)確性。(1)刪除未選擇對象(defun c:sd()(princn 選擇要保留對象 :)(setq SS(ssget) ss1(ssgetX) (commanderasess1rsszoom _e);end;(2)畫

2、圓弧型鐵路; 輸入鐵路中線上三個點(diǎn)，軌距及繪圖比例尺，起、中、始點(diǎn)(setq W1(/(* WD S) 2) W2(+ W1(* 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 點(diǎn)的圓周角(if ( FE 0)(setq FE(+ FE P12)(setq F1(- (/ PI 2) F) AB

3、C(- A2 F1)(if ( ABC 0) (setq ABC(+ ABC P12)(setq C(polar PB ABC R); 求圓心之點(diǎn)位(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, 單獨(dú)插入。, 大大減少手算(defu

4、n c:ytl()(setvar osmode 0);(setq PB(getpointn(setq PM(getpointn(setq PE(getpointn(setq WD(getrealn取消撲捉輸入起點(diǎn)： )輸入中點(diǎn)： )輸入終點(diǎn)： ) 輸入鐵路寬度 (m) ：)(setq S(getrealn繪圖比例尺 =： );1:1000, 輸入軌道及枕木符號的半寬(setq F(+ FB FE) R(/ D(* (sin F)2);求全弧所對圓心角之半，圓弧半徑起點(diǎn)左右垂直于中線切線的方位角中點(diǎn)左右垂直于中線切線的方位角終點(diǎn)左右垂直于中線切線的方位角W2) (setq PML(polar P

5、M ACM W1) PMR(polar PM AMC W1)(setq PEL(polar PE ACE W1) PER(polar PE AEC W1)(setq S2(* S) S4(* 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 ); 畫起點(diǎn)處枕木 (setq DF(/(* 10 S) R); 求一個分段圓弧所對圓心角 (setq FF 0); 動態(tài)分段圓弧之和，所

6、對圓心角初值賦 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)弧度化度分秒函數(shù); 如弧度化為 , 即 20 2350(defun dfm(hdj)(setq jd(/(* hdj 180) pi)(setq du(fix jd); 截去小數(shù) , 提取度數(shù)(setq f1(* 60 (

7、- jd du)(setq ff( fix f1); 截去小數(shù) , 提取分?jǐn)?shù)(setq mm(rtos(* 60 (- f1 ff) 2 0); 按四舍五入提取秒數(shù); 上面的 du,ff 是整型數(shù) ,mm 是字符串(setq du(itoa du) ff(itoa ff); 把 du,ff 轉(zhuǎn)化為字符串(if (strlen ff) 2); 求 ff 長度(setq ff(strcat 0 ff); 如果 ff 長度小于 2，執(zhí)行此表達(dá)式(setq ff ff); 如果 ff 長度等于 2 ，執(zhí)行此表達(dá)式)(if (strlen mm) 2);求 mn 長度(setq mm(strcat 0

8、mm); 如果 mm 長度小于 2,執(zhí)行此表達(dá)式(setq mm mm);如果 mm 長度等于 2，執(zhí)行此表達(dá)式)(setq jd(strcat du . ff mm);把度，小數(shù)點(diǎn) , 分 , 秒放在一個字符串中) ;end;（4）度分秒化成弧度(defun hhd(a); 按 (hhd 調(diào)用(setq a(rtos a 2 4);a(setq ws(strlen a);(setq ad (substr a 1 (- ws 5) ;(setq am (substr a (- ws 3) 2) ;(setq as (substr a (- ws 1) 2) ;(setq a1 (atof ad

9、) ;(setq a2 (atof am);(setq a3 (atof as);(setq ar (+ a1 (/ a2 60) (/ a3 3600)(setq ard (/ (* ar pi) 180)(setq a ard);end轉(zhuǎn)換為字符型求角度 a 的長度，即判斷度數(shù)的位數(shù) 根據(jù)度數(shù)的位數(shù)取數(shù)給 ad 根據(jù)度數(shù)的位數(shù)取數(shù)給 am 根據(jù)度數(shù)的位數(shù)取數(shù)給as 把 ad 轉(zhuǎn)換為實數(shù)把 am 轉(zhuǎn)換為實數(shù)把 as 轉(zhuǎn)換為實數(shù); （5）標(biāo)注面積 （平方米和畝）(defun c:mj()(setq os (getvar osmode);osmode(setq cmd (getvar cmdec

10、ho);CMDECHO(setvar osmode 0)(setvar cmdecho 0)是捕捉系統(tǒng)變量是系統(tǒng)變量(setq p1 (getpoint n(command -boundary p1(setq bj (entlast);(command area o bj);(entdel bj);請在要標(biāo)注封閉區(qū)域內(nèi)點(diǎn)一下 :） ） ; 構(gòu)建多段線邊界 獲得邊界（ bj ）圖元名稱 獲得邊界（ bj ）圖元名稱面積刪除邊界（ bj ）圖元名稱(setq mj (rtos (getvar area) 2 3)(setq area1 (strcat mj fSimSun|b0|i0|c134|p

11、2;平方米 ()(setq ans (* (/ (atof area1) )(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 405) (cons 41 0) (cons71 0)(cons 50 0)(72 . 5)(cons 1 area2); 創(chuàng)建一個新圖元(setvar osmode os)(setvar cmdecho

12、 cmd)(princ);end;(6)對單行文字修改主程序(DEFUN C:GWZ()(princ nselect object:)(setq s (ssget)(GJD); 調(diào)用修改文字角度函數(shù)(GGD); 調(diào)用修改文字高度函數(shù)); 結(jié)束(defun GJD(); 修改文字角度函數(shù)(setq hig (getreal n輸入角度 :)(if (= hig nil) (setq hig )(setq hig (* pi hig) hig (/ hig )(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); 結(jié)束(DEFUN GGD (); 修改文字高度函數(shù)(setq hig (getreal n輸入新字高 :)(if (= hig nil) (setq hig )(setq h40 (cons 40 hig)(setq n (s