《cad程序设计》课程设计指导书

CAD 程序设计课程设计指 导 书环境与建筑工程学院测绘教研室CAD 程序设计课程设计大纲课程类别：比修 学 时：1 周课程性质：实践教学 开课学期：第 7 学期开课专业：测绘工程先修课程： AutoCAD，计算机高级语言一、 课程设计的基本目的与任务本课程设计是测绘工程的专业技术实践课。本实践课的主要目的和任务是：(1)、掌握Visual Lisp 程序设计的方法；（ 2）掌握 Visual Lisp 操纵 AutoCAD 的程序设计方法；（3）掌握在 Visual LISP 中使用 AutoCAD ActiveX 对象的方法；（4）掌握在 Visual LISP 中使用可编程对话框制作用户界面的方法；（5）掌握自定义 AutoCAD界面的方法。二、 教学基本要求课程设计的进行方式是在教师指导下由学生独立完成的。每个学生都应该明确设计任务和要求，并拟定设计计划，注意掌握进度，按时完成。设计分段进行，每一阶段的设计都要认真检查，没有原则错误时才能继续进行下一段设计，以保证设计质量，循序完成设计任务。设计过程中要独立思考、深入钻研，主动地、创造性地进行设计，反对照抄照搬或依赖教师。要求设计态度严肃认真，有错必改，反对敷衍塞责，容忍错误存在。只有这样才能保证课程设计，达到教学基本要求，在设计思想、设计方法和设计技能等方面得到良好的训练。三、 课程设计的内容（1） 通过资料查阅和学习了解 Visual Lisp 程序设计的方法；（2） 设计程序算法、绘制流程图；（3） 建立 AutoCAD 菜单、工具条、按钮；（4） 设计程序的用户界面；（5） 编写程序代码、调试程序；（6） 编写课程设计报告。四、 课程设计的学时分配教学内容 学时 地点1、集中学习 半天 教室资料查阅与学习，讨论 1 天 图书馆、实验室设计程序算法、绘制流程图 2 天 实验室建立 AutoCAD 菜单、工具条、按钮半天 实验室设计程序的用户界面 1 天 实验室编写程序代码、调试程序 1 天 实验室编写课程设计报告 1 天 教室注：课程设计总结论文业余时间完成。五、 课程设计总结论文要求（1） 综述；（2） 设计程序算法、绘制流程图；（3） 建立 AutoCAD 菜单、工具条、按钮的方法；（4） 设计程序的用户界面；（5） 设计总结。（6） 附录：源程序六、 参考题目（1） 判断一个点是否在闭合多边形的里面，该多边形的边界是由线段和园弧组成。（2） 判断一个闭合多段线是否交叉，该多段线是由线段和园弧组成。（3） 用多段线生成 Hatch 实体的边界线。（4） 设计一个程序解决汉诺塔问题：有三根柱子，分别为 A、B、C，A 柱上有一叠按大小顺序叠好的盘子，要求每次只能移动一个盘子，盘子的大小顺序不能改变，且盘子不能离开这三根柱子，将 A 柱上的盘子全部移到 C 柱。（5） 设计一个程序将指定区域外的图形剪断，并将区域内的图形保存到一个文件中。七、 主要参考资料AutoCAD 2004 命令参考AutoCAD 2004 自定义手册软件工程AutoLISP Developers GuideAutoLISP ReferenceDXF 参考ActiveX 和 VBA 开发人员指南 ActiveX and VBA Reference计算机图形学几个 Visual Lisp 程序设计实例第一个实例：判断一指定点与某个三角形的关系(用autolisp 实现 )判断一指定点与某个三角形的关系：1.在三角形三边上；2.在三角形内；3.在三角形外算法:一.输入的数据假设三角形的三顶点为:p1 p2 p3指定点为:p0二.作辅助线1.从 p1 p2 p3 中选择一点 pt 使之与 p0 不相同，三角形的其余点为 pta,ptb2.以 pt 和 p0 作一射线(p0 端无限延长)RL，以 pta 和 ptb 作一构造线(两端无限延长)XL3.求 RL 和 XL 的交点。三.判断两辅助线是否平行4.如果无交点，则 p0 在三角形外；如果有交点，则设交点为 xp四.判断 p0 是否在三角形的三边上5.如果 xp 等于 p0,则进一步判断: 如 p0 在线段(pta-ptb)外,则 p0 在三角形外; 否则 p0;在三角形的三边上6.如果 xp 等于 pta,则进一步判断:如 p0 在线段(pt-pta)外,则 p0 在三角形外; 否则 p0;在三角形的三边上7.如果 xp 等于 ptb,则进一步判断 :如 p0 在线段(pt-ptb)外,则 p0 在三角形外;否则 p0;在三角形的三边上五.判断 p0 是否在三角形外8.如果 xp 在线段(pta-ptb)外,则 p0 在三角形外9.如果 p0 在线段(pt-xp)外,则 p0 在三角形外10.以上条件都不满足,则 p0 在三角形内实现方案1.定义一函数 GetTrianglePoints,获取三角形的三顶点表 lst 2.获取指定点 p03.调整顶点表 lst 使其第一点与 p0 不相等4.以 p0 和 lst 中的第一点组成一构造线,再以 lst 中的第二 ,第三点组成另一构造线并求得其交点 xp.如无交点,则 p0 在三角形外 out=15.定义一函数 IsOutLine(p p1 p2),用以判断一个点 p 是否在另外两个点 p1 p2 组成得线段外6.如果 xp 与 p0 相等,作进一步处理调用 IsOutLine 判断 p0 是否在线段(cadr lst)-(caddr lst)外如 p0 在该线段外,则 p0 在三角形外 out=1;否则 p0 在三角形的三边上 out=27.如果 xp 与 lst 中的第二点相等 ,作进一步处理调用 IsOutLine 判断 p0 是否在线段(car lst)-(cadr lst)外如 p0 在该线段外,则 p0 在三角形外 out=1;否则 p0 在三角形的三边上 out=28.如果 xp 与 lst 中的第三点相等 ,作进一步处理调用 IsOutLine 判断 p0 是否在线段(car lst)-(caddr lst)外如 p0 在该线段外,则 p0 在三角形外 out=1;否则 p0 在三角形的三边上 out=29.调用 IsOutLine 判断 xp 是否在线段(cadr lst)-(caddr lst)外如 xp 在该线段外,则 p0 在三角形外 out=110.调用 IsOutLine 判断 p0 是否在线段(car lst)-xp)外如 xp 在该线段外,则 p0 在三角形外 out=111. 则 p0 在三角形内 out=2 12. 显示对话框输出处理结果源程序如下:;5.定义一函数 IsOutLine(p p1 p2),用以判断一个点 p 是否在另外两个点 p1 p2 组成得线段外;如 p 是在 p1 p2 所组成的线段外,则返回 t,否则 nil ;(DEFUN IsOutLine (p p1 p2 / rt)(IF (EQUAL (CAR p1) (CAR p2) MaxError)(PROGN(SETQ rt (IsOutTwoDouble (CADR p) (CADR p1) (CADR p2)(PROGN(SETQ rt (IsOutTwoDouble (CAR p) (CAR p1) (CAR p2)rt);判断实数 r0 是否在 r1 r2 所组成的区间外;如 r0 是在 r1 r2 所组成的线段外,则返回 t,否则 nil ;(DEFUN IsOutTwoDouble (r0 r1 r2 / tmp rt)(IF ( r1 r2)(SETQ tmp r1r1 r2r2 tmp)(IF (OR ( r0 r2)(SETQ rt T);(setq rt nil)rt);.定义一函数 GetTrianglePoints,获取三角形的三顶点表 lst;如用户选择的是一闭合三角形,返回三顶点表,否则返回 nil;(DEFUN GetTrianglePoints (/ ent lst itm ptlst i)(SETQ ent (ENTSEL “选择一闭合三角形:“)(IF (AND ent(= “LWPOLYLINE“(CDR (ASSOC 0 (SETQ lst (ENTGET (CAR ent)(PROGN(SETQ 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)nilptlst);主函数; Out 1-外 2-线上 3-内;(DEFUN c:IsOutTriangle (/ lst p0 MaxError xp Out str)(SETVAR “cmdecho“ 0)(SETQ MaxError 0.0000001);1.调用函数 GetTrianglePoints,获取三角形的三顶点表 lst;(SETQ lst (GetTrianglePoints);2.获取指定点 p0;(WHILE (AND lst (SETQ p0 (GETPOINT “n 请输入指定点:“)(SETQ out nil);将三维 p0 变成二维 p0;(SETQ p0 (LIST (CAR p0) (CADR p0);3.调整顶点表 lst 使其第一点与 p0 不相等;(IF (EQUAL p0 (CAR lst) MaxError)(SETQ lst (APPEND (CDR lst) (LIST (CAR lst);4.以 p0 和 lst 中的第一点组成一构造线,再以 lst 中的第二,第三点组成另一构造线;并求得其交点 xp.如无交点,则 p0 在三角形外 out=1 ;(IF (= (SETQ xp (INTERS (CAR lst) p0 (CADR lst) (CADDR lst) nil)nil)(SETQ out 1);6.如果 xp 与 p0 相等,作进一步处理;调用 IsOutLine 判断 p0 是否在线段 (cadr lst)-(caddr lst)外 ;如 p0 在该线段外,则 p0 在三角形外 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 中的第二点相等,作进一步处理;调用 IsOutLine 判断 p0 是否在线段 (car lst)-(cadr lst)外;如 p0 在该线段外,则 p0 在三角形外 out=1;否则 p0 在三角形的三边上 out=2;(IF (AND (= out nil) (EQUAL xp (CADR lst) MaxError)(PROGN(IF (IsOutLine p0 (CAR lst) (CADR lst)(SETQ out 1)(SETQ out 2);8.如果 xp 与 lst 中的第三点相等,作进一步处理;调用 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 out 1)(SETQ out 2);9.调用 IsOutLine 判断 xp 是否在线段 (cadr lst)-(caddr lst)外;如 xp 在该线段外,则 p0 在三角形外 out=1;(IF (AND (= out nil) (IsOutLine xp (CADR lst) (CADDR lst)(SETQ out 1);10.调用 IsOutLine 判断 p0 是否在线段 (car lst)-xp)外;如 xp 在该线段外,则 p0 在三角形外 out=1;(IF (AND (= out nil) (IsOutLine p0 (CAR lst) xp)(SETQ out 1);11. 则 p0 在三角形内 out=2;(IF (= out nil)(SETQ str “内“)(IF (= out 1)(SETQ str “外“)(IF (= out 2)(SETQ str “的边线上“);12. 显示对话框输出处理结果;(ALERT (STRCAT “指定点在选定的三角形“ str)(SETVAR “cmdecho“ 1)(PRINC)(PRINC “n 要执行本程序,请输入命令:IsOutTriangle“)第二个实例：判断一指定点与某个区域的关系(用 active 实现)源程序如下：(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 obj)(progn(vlax-release-object obj)(setq obj nil)(if obj(while (setq pt (getpoint “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 水平的图形外一点;(setq objline(vlax-ename-vla-object(entmakex(list (cons 0 “LINE“) (cons 10 pt) (cons 11 ptout);得到一不可见的直线;(setq ptlst (vla-IntersectWith obj objline acExtendNone);求交点;(vla-Delete objline)(vlax-release-object objline)(setq ptlst (vlax-variant-value ptlst)(if (= (vlax-safearray-get-u-bound ptlst 1)(vlax-safearray-get-l-bound ptlst 1)(setq ptlst (vlax-safearray-list ptlst);得到交点坐标组成的表;(setq ptlst nil);无交点;)(setq n 0i 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)(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)(setq n (1+ n);交点附近的图形在直线的一边时，此交点算两个 ;)(if Online(alert “在闭合图形的边界线上 “)(if (= n (* (/ n 2) 2)(alert “在闭合图形的外面 “);双数个交点，在闭合图形的外面;(alert “在闭合图形的里面 “);单数个交点，在闭合图形的里面;)(vlax-release-object obj)(setvar “cmdecho“ 1)(princ)第三个实例：汉诺塔问题源程序如下:(defun Draw (/ ss s x0 x1 x3 i ent boxlst)(initget 7)(setq CengShu (getint “输入层数=“)(setq s (* CengShu 1.1);删除原有图形;(setq ss (ssget “x“)(if ss(vl-cmdf “erase“ ss “);定义块;(if (= *block* nil)(progn(setvar “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“ “)(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.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) “);画柱 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)“c“)(vl-cmdf “line“ (list x2 0.0 0.0) (list x2 s 0.0) “);在柱 0 上画方块;(setq i 0)(while (“)(if ss(progn(setq ent (ssname ss 0)(setvar “cmdecho“ 0)(command “undo“ “BE“);保存最后一个实体(setq LastEnt (entlast);炸开(command “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 技术来判断;获得 object 对象(setq obj (vlax-ename-vla-object ent);获得起点(setq RetVal (vlax-variant-value (vla-get-StartPoint obj)(setq StartPoint (vlax-safearray-list RetVal);获得终点(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-ename-vla-object ent2);判断(setq RetVal (vla-IntersectWith obj obj2 acExtendNone);获得交点(setq Xpints (vlax-variant-value RetVal);获得数组的上下标(setq L (vlax-safearray-get-l-bound Xpints 1)(setq U (vlax-safearray-get-u-bound Xpints 1);判断是否有交点(if ( u 2)(progn;有两个交点(setq IsCross t)(progn(setq Xp (vlax-safearray-list Xpints);如果不等于交点，就是相交(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 “不相交！“)(alert “相交！“)(command “undo“ “E“);取消炸开(command “u“)(setvar “cmdecho“ 1)(prog(alert “没有选中轻多段线，或者选中的轻多段线不闭合！“)(princ)第五：用多段线生成 Hatch 实体的边界线。程序设计思路：1 提示用户选择一个 Hatch 实体2 从 Hatch 的定义数据中取出环的定义数据，丢去不闭合的环及有椭园弧或样条曲线的环3 逐个环生成，一个环生成一个闭合多段线4 结束程序源程序如下：;返回填充实体 Hatch 的闭合边界线,程序丢去不闭合的环及有椭园弧或样条曲线的环(defun GH-GetPtsFromHatch(Hatchent / Lsti LoopN FindNextCodeLoopType ANG ANG1ANG2 BULGE CPTERR HAVEBULGE ISCLOSEDISCOUNTERCLOCKWISE KLINETYPE LOOPS LSTNO PT PTSR Twopi)(setq Twopi (+ pi pi)(defun FindNextCode (code /);调到下一项(setq Lst (cdr Lst)(while (/= code (caar Lst)(setq Lst (cdr Lst)(setq Lst (entget Hatchent);环的个数(FindNextCode 91)(setq LoopN (cdar lst)(setq i 0);一个个取(while ( i LoopN);坐标(setq pts nil)(setq Err nil);环的类型(FindNextCode 92)(setq LoopType (cdar lst)(setq LoopType (Boole 1 LoopType 2)(if (= LoopType 2)(progn;多段线;是否有 Has bulge flag(FindNextCode 72)(setq Havebulge (cdar lst);是否闭合(FindNextCode 73)(setq IsClosed (cdar lst);坐标个数(FindNextCode 93)(setq No (cdar lst)(setq k 0)(while ( k No);获得坐标(FindNextCode 10)(setq pt (cdar LST);获得曲度(if (= Havebulge 1)(progn(FindNextCode 42)(setq bulge (cdar LST)(setq pt (list (car pt) (cadr pt) bulge);添加到列表(setq pts (append pts (list pt)(setq k (1+ k)(progn;不是多段线;本环的线段数(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;添加起点(FindNextCode 10)(setq pt (cdar LST)(setq pts (append pts (list pt);添加终点(FindNextCode 11)(setq pt (cdar LST)(setq pts (a