《利用VBA实现CAD与Excel相结合自动绘制钻孔采样图.doc》由会员分享，可在线阅读，更多相关《利用VBA实现CAD与Excel相结合自动绘制钻孔采样图.doc（2页珍藏版）》请在三一办公上搜索。
1、（浙江省地矿科技有限公司，浙江杭州310007）摘 要 本文介绍了 VBA 开发工具、AutoCAD 和 Excel 应用软件的基本特点，以及通过 VBA 编程建立 AutoCAD 与 Excel 的通信，实现钻孔采样图的自动绘制。关键词 VBA；AutoCAD；Excel；采样图地质找矿工作中，勘探线剖面图是工程设计所需的重要图件，它 能直观的反映地下的矿层分布情况。勘探线剖面图上的钻孔采样图，是 野外钻孔实际采样的数据在图上的直观反映。由于数据量大，在图上一 段段画线、标号，大量的重复操作相当繁琐，而且容易出错，不易检 查，效率又低。本文正是基于这种情况，介绍如何利用 M icrosoft
2、 Ex- cel、AutoCAD 提供的 VBA 扩展模块功能，编制程序实现该过程的自 动化。1 应用环境介绍VBA （Visual Basic for Application） 是 M icrosoft 提供给应用程 序员的基于 ActiveX 技术的面向对象的应用程序开发工具。目前许多流行的应用软件，如 Office97、AutoCAD、Excel 等都内置了 VBA 开发工具，其强大的功能为各应用程序的二次开发提供了一个优秀的手段， 同时也为实现各应用软件间的通信提供了方便。VBA 与 VB 有着几乎相同的开发环境和语法，功能强大，而且它驻留在 AutoCAD 的内部，结构精简，代码运行
3、效率高。AutoCAD 是美国 Autodesk 公司研发的通用计算机辅助绘图和设计软件。目前 AutoCAD 已被广泛应用于建筑、工程等各个领域的制图与设计，它功能强大，界面友好，易于掌握，深得广大设计人员的喜 爱。但是对于专业领域仍然有很多不够的地方，好在 AutoCAD 开放式的体系结构，给了我们很大的空间来扩充新的功能和设计各种应用程 序。M icrosoftExcel 是微软公司的办公软件 M icrosoft office 的组件 之一，它具有直观的界面、出色的计算功能和图表工具，成为最流行的 微机数据处理软件。Excel 强大的功能和良好的人机交互对话界面，可以方便地进行数据处理
4、和 VBA 二次开发，在工程测量中有广泛的运用。2 工作原理在 M icrosoft Excel 中，与表对应的对象是工作表 （sheet 或 Workshee）t ，与每一个表格方格对应的对象是单元格区域 （range）。 工作表对象中的 cells 属性，在单元格的选择方面可以达到与 range 相 同的效果，它是以行 （row） 和列 （co）l 作为参数的，对于行和列的选 择可以采用变量的形式 （cells （i，）j） 来表示。在 AutoCAD 中，通过读取 M icrosoft Excel 文件中的最小对象 单元格区域 （cells （i，）j） 的主要信息，利用 VBA 建立
5、AutoCAD 与 Excel 的通信，然后在 AutoCAD 中指定的位置画线 （使用 AutoCAD 中的 Addline 方法） 和文字 （使用 AutoCAD 中的 Addtext 方法）。通 过循环，遍历所有单元格区域 （cells （i，）j），边读边写，最终完成钻孔 采样的绘制。3 实现步骤及主要代码1） 创建 Excel 数据表，表格样式如图 （1）：图 （1） 数据表2） 在 AutoCAD 中打开 VBA 管理器，创建一个新工程，保存在 适当位置，进入 VBA 集成开发环境。3） 打开 VBA 编辑器菜单的“工具 引用”项，弹出对话框，选择“M icrosoft Excel
6、11.0Object Library”项。4） 创建应用程序对象实例：Subzk() Dim excelnameAsVariant Dim ExcelAsExcel.Application Dim excelsheet AsWorksheet OnErrorResumeNext Set Excel= GetObject(,excel.application) If Err 0ThenErr.Clear Set Excel= CreateObject(excel.application) EndIfexcelname = Excel.GetOpenFilename(excel 文件(* .xls
7、),.xls, , 请选择钻孔数据文件 ) Excel.Workbooks.Openexcelname 打开选择的钻孔数据文件Excel.Visible= False5） 读取 Excel 数据进行画线。表格内容是矿体采样长度数据，这 样可以用 CAD“相对极坐标”的方法获取坐标。 （相对极坐标：相对于某一特定点的极长距离和偏移角度来表示，就是以上一操作点为极点。） 首先在屏幕上指定一个点位置来获取第一点坐标，然后再用 po-larpoint （） 方法获取第二点坐标，即点 2= polarpoint （点 1，弧度，距离）。垂直向下就是 270 度，转换成弧度是 4.7123889，距离就是
8、这里的样长，从 Excel 表中获取。通过统计工作表中的总行数，按行循环逐个读取数据，再用 AddLine （点 1，点 2） 方法画出一段段直线。Set excelsheet = Excel.ActiveWorkbook.Sheets(sheet1)corow = excelsheet.UsedRange.Row s.Count 计算工作表的总EndSub7） 给矿样标编号。因矿样很短，全部标注会太密，所以就隔五个 标一次。用 i 值对 5 取余数，等于 0 则标相应的号。运行结果如图 （2）。行数colum = excelsheet.UsedRange.Columns.Count 计算工作
9、表的总列数sum = 0 angleinradians= 4.7123889 单位为弧度，270 度basepoint = ThisDraw ing.Utility.GetPoint(,select basepoint)zpoint(0)= basepoint(0)- 0.5 左边线坐标zpoint(1)= basepoint(1) ypoint(0)= basepoint(0)+ 0.5 右边线坐标 ypoint(1)= basepoint(1)Fori= 1Tocorow - 1Forj= 1Tocolum If (excelsheet.cells(1,j).Value= 样长 )Then
10、 p= Val(excelsheet.cells(i+ 1,j).Value) 取样长值If (p= 0Or(IsNumeric(p)= False)ThenGoTodoerrEndIf Next j sum = sum + p distance= pnew point = ThisDraw ing.Utility.PolarPoint (basepoint, anglein- radians,distance)Set lineobject = ThisDraw ing.M odelSpace.AddLine(basepoint, new point)lineobject.Update bas
11、epoint = new point直线转多段线a(0)= lineobject.StartPoint(0) a(1)= lineobject.StartPoint(1) a(2)= lineobject.EndPoint(0) a(3)= lineobject.EndPoint(1)Set lw = ThisDraw ing.M odelSpace.AddLightWeightPolyline(a)lineobject.Deletelw.ConstantWidth= 1 设多段线全 4 局宽度6） 定义采样线颜色。为了看清前后矿样，用了两种颜色交替的表 示方法。用 i 值对 2 取余数，等于
12、 0 则设为 255 色，有余数则设 250色，经过循环就能变成一黑一白的线。If iM od2= 0Then 定义线颜色lw.color= 255Else lw.color= 250EndIf CallBianHao(basepoint,i) Next inew point = ThisDraw ing.Utility.PolarPoint (zpoint, angleinradi- ans,sum)Set zline= ThisDraw ing.M odelSpace.AddLine(zpoint,new point)new point = ThisDraw ing.Utility.Pol
13、arPoint (ypoint, angleinradi- ans,sum)Set yline = ThisDraw ing.M odelSpace.AddLine (ypoint, new - point)doerr: 错误处理excelapp.Quit 退出 excel 程序:set excelapp= nothingSet excelsheet = Nothing:Exit Sub图 （2） 运行结果SubBianHao(basepoint AsVariant,iAsInteger) Dim mytxt AsAcadTextStyle Dim strw indow pathAsStrin
14、g Set mytxt = ThisDraw ing.TextStyles.Add(mytxt) strw indow spath= Environ(w indir)mytxt.fontFile = strw indow spath + fontssimfang.ttf 设置字体文件为仿宋体ThisDraw ing.ActiveTextStyle= mytxt 标注钻孔编号Dim zkbh(0To2)AsDouble Dim textobjAsAcadText zkbh(0)= basepoint(0)+ 1 zkbh(1)= basepoint(1) If iM od5= 0ThenSet
15、textobj = ThisDraw ing.M odelSpace.AddText (H & i, zkbh,1.6)ElseIf i= 1ThenSet textobj = ThisDraw ing.M odelSpace.AddText (H & i, zkbh,1.6)EndIfEndSub4 结语本文介绍的程序通过对 AutoCAD 与 Excel 等软件所提供的内置 模块的分析与利用，实现了钻孔采样图绘制的自动化，大大提高了工作效率。同时 AutoCAD 中的 VBA 模块的开发利用提出了一种新的思路。作者简介：朱晓亚，女，助理工程师，浙江省地矿科技有限公司。参考文献1 孔祥丰等译.AutoCAD VBA 从入门到精通.北京:电子工业出版社,2001.2 邓国成,王莉,朱宏.基于 VBA 的 AutoCAD 二次开发在地质图中的应用.工 程地质计算机应用,2009.
