CAD程序設(shè)計(jì)課程設(shè)計(jì)指導(dǎo)書

1、CAD程序設(shè)計(jì)課程設(shè)計(jì)指 導(dǎo) 書環(huán)境與建筑工程學(xué)院測繪教研室CAD程序設(shè)計(jì)課程設(shè)計(jì)大綱課程類別：比修 學(xué) 時(shí)：1周課程性質(zhì)：實(shí)踐教學(xué) 開課學(xué)期：第7學(xué)期開課專業(yè)：測繪工程先修課程： AutoCAD，計(jì)算機(jī)高級語言一、 課程設(shè)計(jì)的基本目的與任務(wù)本課程設(shè)計(jì)是測繪工程的專業(yè)技術(shù)實(shí)踐課。本實(shí)踐課的主要目的和任務(wù)是：(1)、掌握Visual Lisp程序設(shè)計(jì)的方法；（2）掌握Visual Lisp操縱AutoCAD的程序設(shè)計(jì)方法；（3）掌握在 Visual LISP 中使用AutoCAD ActiveX 對象的方法；（4）掌握在 Visual LISP 中使用可編程對話框制作用戶界面的方法；（5）掌握自

2、定義 AutoCAD界面的方法。二、 教學(xué)基本要求課程設(shè)計(jì)的進(jìn)行方式是在教師指導(dǎo)下由學(xué)生獨(dú)立完成的。每個(gè)學(xué)生都應(yīng)該明確設(shè)計(jì)任務(wù)和要求，并擬定設(shè)計(jì)計(jì)劃，注意掌握進(jìn)度，按時(shí)完成。設(shè)計(jì)分段進(jìn)行，每一階段的設(shè)計(jì)都要認(rèn)真檢查，沒有原則錯(cuò)誤時(shí)才能繼續(xù)進(jìn)行下一段設(shè)計(jì)，以保證設(shè)計(jì)質(zhì)量，循序完成設(shè)計(jì)任務(wù)。設(shè)計(jì)過程中要獨(dú)立思考、深入鉆研，主動(dòng)地、創(chuàng)造性地進(jìn)行設(shè)計(jì)，反對照抄照搬或依賴教師。要求設(shè)計(jì)態(tài)度嚴(yán)肅認(rèn)真，有錯(cuò)必改，反對敷衍塞責(zé)，容忍錯(cuò)誤存在。只有這樣才能保證課程設(shè)計(jì)，達(dá)到教學(xué)基本要求，在設(shè)計(jì)思想、設(shè)計(jì)方法和設(shè)計(jì)技能等方面得到良好的訓(xùn)練。三、 課程設(shè)計(jì)的內(nèi)容（1） 通過資料查閱和學(xué)習(xí)了解Visual Lisp程

3、序設(shè)計(jì)的方法；（2） 設(shè)計(jì)程序算法、繪制流程圖；（3） 建立AutoCAD菜單、工具條、按鈕；（4） 設(shè)計(jì)程序的用戶界面；（5） 編寫程序代碼、調(diào)試程序；（6） 編寫課程設(shè)計(jì)報(bào)告。四、 課程設(shè)計(jì)的學(xué)時(shí)分配 教學(xué)內(nèi)容學(xué)時(shí)地點(diǎn)1、集中學(xué)習(xí)半天教室資料查閱與學(xué)習(xí)，討論1天圖書館、實(shí)驗(yàn)室設(shè)計(jì)程序算法、繪制流程圖2天實(shí)驗(yàn)室建立AutoCAD菜單、工具條、按鈕半天實(shí)驗(yàn)室設(shè)計(jì)程序的用戶界面1天實(shí)驗(yàn)室編寫程序代碼、調(diào)試程序1天實(shí)驗(yàn)室編寫課程設(shè)計(jì)報(bào)告1天教室注：課程設(shè)計(jì)總結(jié)論文業(yè)余時(shí)間完成。五、 課程設(shè)計(jì)總結(jié)論文要求（1） 綜述；（2） 設(shè)計(jì)程序算法、繪制流程圖；（3） 建立AutoCAD菜單、工具條、按鈕的方

4、法；（4） 設(shè)計(jì)程序的用戶界面；（5） 設(shè)計(jì)總結(jié)。（6） 附錄：源程序六、 參考題目（1） 判斷一個(gè)點(diǎn)是否在閉合多邊形的里面，該多邊形的邊界是由線段和園弧組成。（2） 判斷一個(gè)閉合多段線是否交叉，該多段線是由線段和園弧組成。（3） 用多段線生成Hatch實(shí)體的邊界線。（4） 設(shè)計(jì)一個(gè)程序解決漢諾塔問題：有三根柱子，分別為A、B、C，A柱上有一疊按大小順序疊好的盤子，要求每次只能移動(dòng)一個(gè)盤子，盤子的大小順序不能改變，且盤子不能離開這三根柱子，將A柱上的盤子全部移到C柱。（5） 設(shè)計(jì)一個(gè)程序?qū)⒅付▍^(qū)域外的圖形剪斷，并將區(qū)域內(nèi)的圖形保存到一個(gè)文件中。七、 主要參考資料AutoCAD 2004 命令參

5、考AutoCAD 2004 自定義手冊軟件工程AutoLISP Developer's GuideAutoLISP ReferenceDXF 參考ActiveX 和 VBA 開發(fā)人員指南ActiveX and VBA Reference計(jì)算機(jī)圖形學(xué)幾個(gè)Visual Lisp程序設(shè)計(jì)實(shí)例第一個(gè)實(shí)例：判斷一指定點(diǎn)與某個(gè)三角形的關(guān)系(用autolisp實(shí)現(xiàn))判斷一指定點(diǎn)與某個(gè)三角形的關(guān)系：1.在三角形三邊上；2.在三角形內(nèi)；3.在三角形外算法:一.輸入的數(shù)據(jù)假設(shè)三角形的三頂點(diǎn)為:p1 p2 p3指定點(diǎn)為:p0二.作輔助線1.從p1 p2 p3中選擇一點(diǎn)pt使之與p0不相同，三角形的其余點(diǎn)為p

6、ta,ptb2.以pt和p0作一射線(p0端無限延長)RL，以pta和ptb作一構(gòu)造線(兩端無限延長)XL3.求RL和XL的交點(diǎn)。三.判斷兩輔助線是否平行4.如果無交點(diǎn)，則p0在三角形外；如果有交點(diǎn)，則設(shè)交點(diǎn)為xp四.判斷p0是否在三角形的三邊上5.如果xp等于p0,則進(jìn)一步判斷: 如p0在線段(pta-ptb)外,則p0在三角形外;否則p0;在三角形的三邊上6.如果xp等于pta,則進(jìn)一步判斷:如p0在線段(pt-pta)外,則p0在三角形外;否則p0;在三角形的三邊上7.如果xp等于ptb,則進(jìn)一步判斷:如p0在線段(pt-ptb)外,則p0在三角形外;否則p0;在三角形的三邊上五.判斷p

7、0是否在三角形外8.如果xp在線段(pta-ptb)外,則p0在三角形外9.如果p0在線段(pt-xp)外,則p0在三角形外10.以上條件都不滿足,則p0在三角形內(nèi)實(shí)現(xiàn)方案1.定義一函數(shù)GetTrianglePoints,獲取三角形的三頂點(diǎn)表lst 2.獲取指定點(diǎn)p03.調(diào)整頂點(diǎn)表lst使其第一點(diǎn)與p0不相等4.以p0和lst中的第一點(diǎn)組成一構(gòu)造線,再以lst中的第二,第三點(diǎn)組成另一構(gòu)造線并求得其交點(diǎn)xp.如無交點(diǎn),則p0在三角形外out=15.定義一函數(shù)IsOutLine(p p1 p2),用以判斷一個(gè)點(diǎn)p是否在另外兩個(gè)點(diǎn)p1 p2組成得線段外6.如果xp與p0相等,作進(jìn)一步處理調(diào)用IsOu

8、tLine判斷p0是否在線段(cadr lst)-(caddr lst)外如p0在該線段外,則p0在三角形外out=1;否則p0在三角形的三邊上out=27.如果xp與lst中的第二點(diǎn)相等,作進(jìn)一步處理調(diào)用IsOutLine判斷p0是否在線段(car lst)-(cadr lst)外如p0在該線段外,則p0在三角形外out=1;否則p0在三角形的三邊上out=28.如果xp與lst中的第三點(diǎn)相等,作進(jìn)一步處理調(diào)用IsOutLine判斷p0是否在線段(car lst)-(caddr lst)外如p0在該線段外,則p0在三角形外out=1;否則p0在三角形的三邊上out=29.調(diào)用IsOutLin

9、e判斷xp是否在線段(cadr lst)-(caddr lst)外如xp在該線段外,則p0在三角形外out=110.調(diào)用IsOutLine判斷p0是否在線段(car lst)-xp)外如xp在該線段外,則p0在三角形外out=111. 則p0在三角形內(nèi)out=2 12. 顯示對話框輸出處理結(jié)果源程序如下:;5.定義一函數(shù)IsOutLine(p p1 p2),用以判斷一個(gè)點(diǎn)p是否在另外兩個(gè)點(diǎn)p1 p2組成得線段外;如p是在p1 p2所組成的線段外,則返回 t,否則 nil ;(DEFUN IsOutLine (p p1 p2 / rt) (IF (EQUAL (CAR p1) (CAR p2)

10、MaxError) (PROGN (SETQ rt (IsOutTwoDouble (CADR p) (CADR p1) (CADR p2) ) (PROGN (SETQ rt (IsOutTwoDouble (CAR p) (CAR p1) (CAR p2) ) ) rt);判斷實(shí)數(shù)r0是否在r1 r2所組成的區(qū)間外;如r0是在r1 r2所組成的線段外,則返回 t,否則 nil ;(DEFUN IsOutTwoDouble (r0 r1 r2 / tmp rt) (IF (> r1 r2) (SETQ tmp r1 r1 r2 r2 tmp ) ) (IF (OR (< r0 r

11、1) (> r0 r2) (SETQ rt T) ;(setq rt nil) ) rt);.定義一函數(shù)GetTrianglePoints,獲取三角形的三頂點(diǎn)表lst;如用戶選擇的是一閉合三角形,返回三頂點(diǎn)表,否則返回nil;(DEFUN GetTrianglePoints (/ ent lst itm ptlst i) (SETQ ent (ENTSEL "選擇一閉合三角形:") (IF (AND ent (= "LWPOLYLINE" (CDR (ASSOC 0 (SETQ lst (ENTGET (CAR ent) ) ) (PROGN (S

12、ETQ i 0) (WHILE (SETQ itm (NTH i lst)(WHILE (AND itm (/= 10 (CAR itm) (SETQ i (1+ i) (SETQ itm (NTH i lst)(IF itm (SETQ ptlst (APPEND ptlst (LIST (CDR itm)(SETQ i (1+ i) ) ) ) (IF (OR (= ptlst nil) (/= (LENGTH ptlst) 3) nil ptlst );主函數(shù); Out 1-外 2-線上 3-內(nèi);(DEFUN c:IsOutTriangle (/ lst p0 MaxError xp O

13、ut str) (SETVAR "cmdecho" 0) (SETQ MaxError 0.0000001);1.調(diào)用函數(shù)GetTrianglePoints,獲取三角形的三頂點(diǎn)表lst; (SETQ lst (GetTrianglePoints);2.獲取指定點(diǎn)p0; (WHILE (AND lst (SETQ p0 (GETPOINT "n請輸入指定點(diǎn):") (SETQ out nil) ;將三維p0變成二維p0; (SETQ p0 (LIST (CAR p0) (CADR p0);3.調(diào)整頂點(diǎn)表lst使其第一點(diǎn)與p0不相等; (IF(EQUAL p0

14、 (CAR lst) MaxError) (SETQ lst (APPEND (CDR lst) (LIST (CAR lst) );4.以p0和lst中的第一點(diǎn)組成一構(gòu)造線,再以lst中的第二,第三點(diǎn)組成另一構(gòu)造線;并求得其交點(diǎn)xp.如無交點(diǎn),則p0在三角形外out=1 ; (IF(= (SETQ xp (INTERS (CAR lst) p0 (CADR lst) (CADDR lst) nil) nil) (SETQ out 1) );6.如果xp與p0相等,作進(jìn)一步處理;調(diào)用IsOutLine判斷p0是否在線段(cadr lst)-(caddr lst)外 ;如p0在該線段外,則p0在

15、三角形外out=1;否則p0在三角形的三邊上out=2; (IF(AND (= out nil) (EQUAL xp p0 MaxError) (PROGN(IF (IsOutLine p0 (CADR lst) (CADDR lst) (SETQ out 1) (SETQ out 2) ) );7.如果xp與lst中的第二點(diǎn)相等,作進(jìn)一步處理;調(diào)用IsOutLine判斷p0是否在線段(car lst)-(cadr lst)外;如p0在該線段外,則p0在三角形外out=1;否則p0在三角形的三邊上out=2; (IF(AND (= out nil) (EQUAL xp (CADR lst) M

16、axError) (PROGN(IF (IsOutLine p0 (CAR lst) (CADR lst) (SETQ out 1) (SETQ out 2) ) );8.如果xp與lst中的第三點(diǎn)相等,作進(jìn)一步處理;調(diào)用IsOutLine判斷p0是否在線段(car lst)-(caddr lst)外;如p0在該線段外,則p0在三角形外out=1;否則p0在三角形的三邊上out=2; (IF(AND (= out nil) (EQUAL xp (CADDR lst) MaxError) (PROGN(IF (IsOutLine p0 (CAR lst) (CADDR lst) (SETQ ou

17、t 1) (SETQ out 2) ) );9.調(diào)用IsOutLine判斷xp是否在線段(cadr lst)-(caddr lst)外;如xp在該線段外,則p0在三角形外out=1; (IF(AND (= out nil) (IsOutLine xp (CADR lst) (CADDR lst) (SETQ out 1) );10.調(diào)用IsOutLine判斷p0是否在線段(car lst)-xp)外;如xp在該線段外,則p0在三角形外out=1; (IF(AND (= out nil) (IsOutLine p0 (CAR lst) xp) (SETQ out 1) );11. 則p0在三角形

18、內(nèi)out=2; (IF(= out nil) (SETQ str "內(nèi)") ) (IF(= out 1) (SETQ str "外") ) (IF(= out 2) (SETQ str "的邊線上") );12. 顯示對話框輸出處理結(jié)果; (ALERT (STRCAT "指定點(diǎn)在選定的三角形" str) ) (SETVAR "cmdecho" 1) (PRINC)(PRINC "n要執(zhí)行本程序,請輸入命令:IsOutTriangle")第二個(gè)實(shí)例：判斷一指定點(diǎn)與某個(gè)區(qū)域的關(guān)系

19、(用active實(shí)現(xiàn))源程序如下：(vl-load-com)(defun InorOut (/ ent pt obj minpt maxpt ptout objlineptlst n i xp Param Deriv Online p1p2 ) (setvar "cmdecho" 0) (setq ent (entsel "n選擇一閉合圖形") (if ent (progn (setq ent (car ent) (setq obj (vlax-ename->vla-object ent) (if (not (vlax-curve-isClosed

20、 obj)(progn (vlax-release-object obj) (setq obj nil) ) ) ) (if obj (while (setq pt (getpoint "n輸入測試點(diǎn)=") (setq Online nil) (vla-getBoundingBox obj 'minpt 'maxpt) (setq ptout (vlax-safearray->list minpt) (setq ptout (list (- (car ptout) 1000.0) (cadr pt) 0.0) ;得到與pt水平的圖形外一點(diǎn); (setq

21、 objline (vlax-ename->vla-object (entmakex (list (cons 0 "LINE") (cons 10 pt) (cons 11 ptout) ) ) ) ;得到一不可見的直線; (setq ptlst (vla-IntersectWith obj objline acExtendNone) ;求交點(diǎn); (vla-Delete objline) (vlax-release-object objline) (setq ptlst (vlax-variant-value ptlst) (if (>= (vlax-safea

22、rray-get-u-bound ptlst 1) (vlax-safearray-get-l-bound ptlst 1) )(setq ptlst (vlax-safearray->list ptlst);得到交點(diǎn)坐標(biāo)組成的表;(setq ptlst nil);無交點(diǎn); ) (setq n 0 i 0 ) (while (and ptlst (nth i ptlst) (= Online nil)(setq xp (list (nth i ptlst) (nth (1+ i) ptlst) (nth (+ 2 i) ptlst)(setq n (1+ n)(setq i (+ i 3

23、)(if (equal pt xp 0.000001) (setq Online t)(if (= Online nil) (progn (setq Param (vlax-curve-getParamAtPoint obj xp) (setq p1 (vlax-curve-getPointAtParam obj (- Param 0.01) (setq p2 (vlax-curve-getPointAtParam obj (+ Param 0.01) (if (or (and (< (cadr xp) (cadr p1) (< (cadr xp) (cadr p2) (and (

24、> (cadr xp) (cadr p1) (> (cadr xp) (cadr p2) ) (setq n (1+ n) ;交點(diǎn)附近的圖形在直線的一邊時(shí)，此交點(diǎn)算兩個(gè); ) ) ) (if Online(alert "在閉合圖形的邊界線上")(if (= n (* (/ n 2) 2) (alert "在閉合圖形的外面") ;雙數(shù)個(gè)交點(diǎn)，在閉合圖形的外面; (alert "在閉合圖形的里面") ;單數(shù)個(gè)交點(diǎn)，在閉合圖形的里面;) ) ) ) (vlax-release-object obj) (setvar "

25、cmdecho" 1) (princ)第三個(gè)實(shí)例：漢諾塔問題源程序如下:(defun Draw (/ ss s x0 x1 x3 i ent boxlst) (initget 7) (setq CengShu (getint "輸入層數(shù)=") (setq s (* CengShu 1.1) ;刪除原有圖形; (setq ss (ssget "x") (if ss (vl-cmdf "erase" ss "") ) ;定義塊; (if (= *block* nil) (progn (setvar "

26、;clayer" "0") (setvar "CECOLOR" "byblock") (vl-cmdf "pline" (list -0.5 0.0 0.0) (list 0.5 0.0 0.0) (list 0.5 1 0.0) (list -0.5 1 0.0) "c" ) (vl-cmdf "bhatch" "s" (setq ent(entlast) "" "p" "solid"

27、 "") (entdel ent) (vl-cmdf "block" "box" (list 0.0 0.0 0.0) (entlast) "") (setq *block* "box") (setvar "CECOLOR" "bylayer") ) ) ;畫柱 0; (setq X0 0.0) (vl-cmdf "line" (list (+ x0 (* -0.5 s) 0.0 0.0) (list (+ x0 (* 0.5 s) 0

28、.0 0.0) "" ) (vl-cmdf "line" (list x0 0.0 0.0) (list x0 s 0.0) "") ;畫柱 1; (setq x1 (+ x0 (* s 1.2) (vl-cmdf "line" (list (+ x1 (* -0.5 s) 0.0 0.0) (list (+ x1 (* 0.5 s) 0.0 0.0) "" ) (vl-cmdf "line" (list x1 0.0 0.0) (list x1 s 0.0) "&

29、quot;) ;畫柱 2; (setq x2 (+ x1 (* s 1.2) (vl-cmdf "line" (list (+ x2 (* -0.5 s) 0.0 0.0) (list (+ x2 (* 0.5 s) 0.0 0.0) "" ) (vl-cmdf "pline" (list (* -1.0 s) (* -1.0 s) 0.0) (list (+ x2 s) (* -1.0 s) 0.0) (list (+ x2 s) (* 1.2 s) 0.0) (list (* -1.0 s) (* 1.2 s) 0.0) &quo

30、t;c" ) (vl-cmdf "line" (list x2 0.0 0.0) (list x2 s 0.0) "") ;在柱0上畫方塊; (setq i 0) (while (< i CengShu) (vl-cmdf "insert" *block* (list x0 i 0.0) (- CengShu i) 1 0) (setq ent (entlast) (vl-cmdf "change" ent "" "p" "c" (- Ce

31、ngShu i) "") (setq boxlst (append boxlst (list ent) (setq i (1+ i) ) (vl-cmdf "zoom" "e") (list (list x0 boxlst) (list x1 nil) (list x2 nil)(defun MoveOne (From To / boxlstFrom boxlstTo XFromXTo itm Ent s p1 p2 p nang i ang0 mp lst ) (setq itm (nth From *Boxs*) (setqXFr

32、om (nth 0 itm)boxlstFrom (nth 1 itm) ) (setq itm (nth To *Boxs*) (setqXTo (nth 0 itm)boxlstTo (nth 1 itm) ) (setq boxlstFrom (reverse boxlstFrom) (setqEnt (car boxlstFrom)boxlstFrom (cdr boxlstFrom) ) (setq boxlstFrom (reverse boxlstFrom) (setq boxlstTo (append boxlstTo (list Ent) (setq p1 (list XFr

33、om (length boxlstFrom) 0.0) (setq p2 (list XTo (1- (length boxlstTo) 0.0) (setq s (distance p1 p2) (setqp (list(/ (+ (car p1) (car p2) 2.0)(/ (+ (cadr p1) (cadr p2) 2.0)0.0 ) ) (setqn 10i 1 ) (setq ang (/ (- (angle p p2) (setq ang0 (angle p p1) n) (while (<= i n) (setq mp (polar p (+ ang0 (* i an

34、g) (* 0.5 s) (setq lst (entget ent) (setq old (assoc 10 lst) (setq lst (subst (list 10 (car mp) (cadr mp) 0.0) old lst) (entmod lst) (setq i (1+ i) (vl-cmdf "delay" 30) ) (setq *Boxs* (subst (list XFrom boxlstFrom) (assoc XFrom *Boxs*) *Boxs*) ) (setq *Boxs* (subst (list XTo boxlstTo) (ass

35、oc XTo *Boxs*) *Boxs*)(defun MoveMore(n A B C /) (if (= n 1) (progn (MoveOne A C) ) (progn (MoveMore (1- n) A C B) (MoveOne A C) (MoveMore (1- n) B A C) ) )(defun c:MoveBox () (setvar "cmdecho" 0) (setvar "osmode" 0) (if (or (= nil (ssget "x") (= *Boxs* nil) (setq *Boxs

36、* (Draw) ) (MoveMore CengShu 0 1 2) (princ)(princ "n輸入命令:MoveBoxn")(princ)第四 ：判斷一個(gè)閉合多段線是否交叉，該多段線是由線段和園弧組成。程序設(shè)計(jì)思路：1 提示用戶選擇一個(gè)閉合輕多段線2 將該閉合輕多段線炸開3 逐段測試其交叉性4 輸出結(jié)果5 恢復(fù)（或取消）炸開操作6 結(jié)束程序源程序如下：(defun c:Xmapcross (/ ent ss LastEnt Lst ENDPOINT ENT2 I ISCROSS J L OBJ OBJ2 RETVAL STARTPOINT U XP XPINTS

37、) (setqss (ssget ":S" '(0 . "LWPOLYLINE") (-4 . "<or") (70 . 1) (70 . 129) (-4 . "or>") ) ) ) (if ss (progn (setq ent (ssname ss 0) (setvar "cmdecho" 0) (command "undo" "BE") ;保存最后一個(gè)實(shí)體 (setq LastEnt (entlast) ;炸開 (comman

38、d "explode" ent "") ;獲得組成多段線的線段 (while (setq LastEnt (entnext LastEnt)(setq lst (append lst (list LastEnt) ) ;逐段比較 (setq i 0) (setq IsCross nil) (while (and (= IsCross nil) (setq ent (nth i lst)(setq i (1+ i);使用Active技術(shù)來判斷;獲得object對象(setq obj (vlax-ename->vla-object ent);獲得起點(diǎn)(

39、setq RetVal (vlax-variant-value (vla-get-StartPoint obj)(setq StartPoint (vlax-safearray->list RetVal);獲得終點(diǎn)(setq RetVal (vlax-variant-value (vla-get-EndPoint obj)(setq EndPoint (vlax-safearray->list RetVal)(setq j i)(while (setq ent2 (nth j lst) (setq j (1+ j) ;獲得object對象 (setq obj2 (vlax-enam

40、e->vla-object ent2) ;判斷 (setq RetVal (vla-IntersectWith obj obj2 acExtendNone) ;獲得交點(diǎn) (setq Xpints (vlax-variant-value RetVal) ;獲得數(shù)組的上下標(biāo) (setq L (vlax-safearray-get-l-bound Xpints 1) (setq U (vlax-safearray-get-u-bound Xpints 1) ;判斷是否有交點(diǎn) (if (<= L u) (progn ;有，測試交點(diǎn)是不是端點(diǎn) (if (> u 2)(progn ;有兩

41、個(gè)交點(diǎn) (setq IsCross t)(progn (setq Xp (vlax-safearray->list Xpints) ;如果不等于交點(diǎn)，就是相交 (if (and (= (equal StartPoint Xp 0.001) nil) (= (equal EndPoint Xp 0.001) nil) ) (setq IsCross t) ) ) ) ) ;釋放對象 (vlax-release-object obj2);釋放對象(vlax-release-object obj) ) (if (= IsCross nil)(alert "不相交！")(al

42、ert "相交！") ) (command "undo" "E") ;取消炸開 (command "u") (setvar "cmdecho" 1) ) (prog (alert "沒有選中輕多段線，或者選中的輕多段線不閉合！") ) ) (princ)第五：用多段線生成Hatch實(shí)體的邊界線。程序設(shè)計(jì)思路：1 提示用戶選擇一個(gè)Hatch實(shí)體2 從Hatch的定義數(shù)據(jù)中取出環(huán)的定義數(shù)據(jù)，丟去不閉合的環(huán)及有橢園弧或樣條曲線的環(huán)3 逐個(gè)環(huán)生成，一個(gè)環(huán)生成一個(gè)閉合多段線4 結(jié)束程序

43、源程序如下：;返回填充實(shí)體Hatch的閉合邊界線,程序丟去不閉合的環(huán)及有橢園弧或樣條曲線的環(huán)(defun GH-GetPtsFromHatch (Hatchent / Lst i LoopN FindNextCode LoopType ANG ANG1 ANG2 BULGE CPT ERR HAVEBULGE ISCLOSED ISCOUNTERCLOCKWISE K LINETYPE LOOPS LST NO PT PTS R Twopi ) (setq Twopi (+ pi pi) (defun FindNextCode (code /) ;調(diào)到下一項(xiàng) (setq Lst (cdr Ls

44、t) (while (/= code (caar Lst) (setq Lst (cdr Lst) ) ) (setq Lst (entget Hatchent) ;環(huán)的個(gè)數(shù) (FindNextCode 91) (setq LoopN (cdar lst) (setq i 0) ;一個(gè)個(gè)取 (while (< i LoopN) ;坐標(biāo) (setq pts nil) (setq Err nil) ;環(huán)的類型 (FindNextCode 92) (setq LoopType (cdar lst) (setq LoopType (Boole 1 LoopType 2) (if(= LoopTy

45、pe 2) (progn;多段線;是否有Has bulge flag(FindNextCode 72)(setq Havebulge (cdar lst);是否閉合(FindNextCode 73)(setq IsClosed (cdar lst);坐標(biāo)個(gè)數(shù)(FindNextCode 93)(setq No (cdar lst)(setq k 0)(while (< k No) ;獲得坐標(biāo) (FindNextCode 10) (setq pt (cdar LST) ;獲得曲度 (if (= Havebulge 1) (progn (FindNextCode 42) (setq bulge

46、 (cdar LST) (setq pt (list (car pt) (cadr pt) bulge) ) ) ;添加到列表 (setq pts (append pts (list pt) (setq k (1+ k) ) (progn;不是多段線;本環(huán)的線段數(shù)(FindNextCode 93)(setq No (cdar lst)(setq k 0)(while (< k No) ;線段的類型 (FindNextCode 72) (setq LineType (cdar LST) (cond (= LineType 1) ;直線段 (if (= pts nil)(progn ;添加起

47、點(diǎn) (FindNextCode 10) (setq pt (cdar LST) (setq pts (append pts (list pt) ) ;添加終點(diǎn) (FindNextCode 11) (setq pt (cdar LST) (setq pts (append pts (list pt) ) (= LineType 2) ;園弧段 ;圓心 (FindNextCode 10) (setq Cpt (cdar LST) ;半徑 (FindNextCode 40) (setq R (cdar LST) ;開始角度, (FindNextCode 50) (setq ang1 (cdar LS

48、T) ;結(jié)束角 (FindNextCode 51) (setq ang2 (cdar LST) ;是逆時(shí)針嗎 (FindNextCode 73) (setq Iscounterclockwise (cdar LST) ;計(jì)算 bulge (setq ang (- ang2 ang1) (if (< ang 0.0)(setq ang (+ ang Twopi) ) ;將順時(shí)針角度，調(diào)為逆時(shí)針角度 (if (= Iscounterclockwise 0)(progn (setq ang1 (- Twopi ang1) (setq ang2 (- Twopi ang2) ) (if (= p

49、ts nil)(progn ;添加起點(diǎn) ;計(jì)算起點(diǎn) (setq pt (polar Cpt ang1 R) (setq pts (append pts (list pt) ) (if (= Iscounterclockwise 1)(setq Iscounterclockwise +1.0)(setq Iscounterclockwise -1.0) ) (setq ang (/ ang 4.0) (setq bulge (* Iscounterclockwise (/ (sin ang) (cos ang) ) ;替換前點(diǎn)的bulge (setq pts (reverse pts) (setq pt (car pts) (setq pts (cdr pts) (setq pts (reverse pts) (setq pt (list (car pt) (cadr pt) bulge) (setq pts (append pts (list p