《利用VBA实现CAD与Excel相结合自动绘制钻孔采样图》由会员分享,可在线阅读,更多相关《利用VBA实现CAD与Excel相结合自动绘制钻孔采样图(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.