《CAD程序设计》课程设计指导书.doc

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 Developer's 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 r1 r1 r2 r2 tmp ) ) (IF (OR (< r0 r1) (> 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) nil ptlst );主函数; 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 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)(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 (> (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 (< i CengShu) (vl-cmdf "insert" *block* (list x0 i 0.0) (- CengShu i) 1 0) (setq ent (entlast) (vl-cmdf "change" ent "" "p" "c" (- CengShu 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*) (setqXFrom (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 XFrom (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 ang) (* 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) (assoc 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* (Draw) ) (MoveMore CengShu 0 1 2) (princ)(princ "n输入命令:MoveBoxn")(princ)第四 ：判断一个闭合多段线是否交叉，该多段线是由线段和园弧组成。程序设计思路：1 提示用户选择一个闭合轻多段线2 将该闭合轻多段线炸开3 逐段测试其交叉性4 输出结果5 恢复（或取消）炸开操作6 结束程序源程序如下：(defun c:Xmapcross (/ ent ss LastEnt Lst ENDPOINT ENT2 I ISCROSS J L OBJ OBJ2 RETVAL STARTPOINT U XP XPINTS ) (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") ;保存最后一个实体 (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 (<= L u) (progn ;有，测试交点是不是端点 (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 / Lst i LoopN FindNextCode LoopType ANG ANG1 ANG2 BULGE CPT ERR HAVEBULGE ISCLOSED ISCOUNTERCLOCKWISE K LINETY