专题-柱状图绘制软件

柱状图绘制软件摘 要本系统通过利用VB编程从Excel中读取数据，在AutoCAD中实现自动绘制柱状图，具有一定实用性。关键词CAD二次开发 柱状图 VB Excel 1 概述随着科学的发展，计算机在采矿领域的应用应用已越来越广，其中一个重要的应用方向就是计算机辅助制图（CAD）。在煤炭行业，CAD的应用已相当普遍，但制图自动化程度较低，生产、设计单位也缺少这方面的软件，由此给我们一个思路，通过编程实现绘图的自动化。Autodesk公司的AutoCAD是当今世界上最畅销的绘图软件之一，已成为广大工程技术人员最好的设计助手。它具有强大的绘图功能，同时，具有开放性，用户可以根据自己的实际需要及专业性质，对CAD进行二次开发，从而更加完善地为本专业服务，这也是CAD受欢迎的重要原因之一。Mcrosoft公司的Visual Basic6.0是当今最畅销的编程语言之一，为软件开发者提供了良好的开发环境；简单易学，功能强大。而CAD内部的VBA开发工具，使以上两套功能强大的软件可以无间隙地结合在一起，让用户可以很轻松地开发出自己满意的软件。为此采用AutoCAD的ActiveX技术及Visual Basic 6.0、Mcrosoft Excel来编制软件。柱状图是采矿制图中需经常绘制的一部分，且柱状图具有较大的相似性，为其自动处理提供了可能。下面介绍的就是用VB对CAD进行二次开发，绘制柱状图的软件。2 系统目标用户选择已输入数据的Excel文件，并设置了相应参数或采取默认值以后，系统自动完成柱状图的绘制，并进行标注。为了做到功能全面，操作简单，要求系统能达到这样的要求：当用户改变某一参数（如柱状图的宽度）时，系统对其它参数进行自动调整，努力使柱状图谐调，美观，使“柱状图绘制”做到真正的“自动化”。这一点是整个系统设计的重点与难点。3 设计原则本系统的设计应按软件工程的步骤一步步进行，不应盲目进入代码编制阶段，首先看有关资料，进行练习，完成必要的技术储备，然后进行系统的总体设计、详细设计，接着才是编码阶段，最后反复调试，使之能达到预期的要求。4 设计思想由于柱状图的画法基本一致，故本程序将柱状图的各个组成部分，等的绘制编制成函数或子过程，当选择不同类型的巷道时，调用相应的函数或子过程，完成柱状图的自动绘制。同时，各个函数或子过程可随着柱状图参数的变化（如柱状图宽度的不同）绘制出不同的柱状图。5 程序流程图图5.1 程序流程图6 系统介绍6.1 系统功能本系统能在AutoCAD环境中自动完成柱状图的绘制，并标注各岩层性质，并能根据用户设置的主要参数（如宽度）来自动调整和改变柱状图的形状，使柱状图协调、美观。图6.程序界面6.2 界面介绍1.用户首先需要选择保存有柱状图数据的Excel文件。单击驱动器列表框，则目录列表框列出当前驱动器中的文件。2.在目录列表框中单击柱状图数据文件所在的文件夹，则在文件列表框列出该文件夹包含的所有保存有柱状图数据的Excel文件。3.单击文件名则程序将自动打开该Excel文件，并将该文件内的所有工作表的名称在列表框中列出。4.单击列表框中的工作表，在窗体右上方的OLE控件中显示该工作表中的内容，便于用户核对数据，同时“添加”按钮变为可用。用户也可以通过双击该控件，打开对应的Excel工作表，更改数据后保存，重复以上步骤即可继续绘图。如果用户想重新输入数据，还可以单击“重新输入数据”按钮，打开新的工作表，输入完成后保存，重复以上步骤即可继续绘图。OLE控件显示数据表如图6.2。图6.2 OLE控件显示Excel表界面5.单击“添加”按钮程序自动读取所选Excel工作表中数据并存储。同时在Date控件中显示文件名及对应柱状图序号。6.单击“启动”按钮，打开AutoCAD，这一步可以忽略，而直接绘图。7.单击“绘图”按钮程序自动完成柱状图的绘制并提示绘制完成。绘制完效果图如图6.3。8.单击“退出”按钮结束程序，并清空对象，释放占用空间。7 系统编制过程7.1 引用各类的库要实现用Visual Basic语言对AutoCAD的二次开发，首先要用倒的是VB与AutoCAD的连接，先打开VB的工程引用，选择AutoCAD 2004 type library，如图7.1。然后的准备工作就是VB与Excel的连接，引用VB中的标准库Microsoft Excel 11.0 Object Library，加载方法同上，打开VB的工程引用，选择Microsoft Excel 11.0 library，如图7.1。图7.1应用各类库图6.3 绘制完毕效果图7.2 Visual Basic与AutoCAD的连接Visual Basic语言对AutoCAD的二次开发，就要使Visaul Basic的程序能调用CAD的命令并能在CAD的环境下由程序控制进行自动绘图。首先在Visaul Basic模块中申明一组对象。代码如下：定义AutoCAD对象Public AcadApp As ObjectPublic AcadDoc As ObjectPublic AcadMds As ObjectPublic AcadUtil As Object连接CADPublic Sub qidongCAD()On Error Resume Next Set AcadApp = GetObject(, autocad.application) If Err Then Set AcadApp = CreateObject(autocad.application) End If Set AcadDoc = AcadApp.ActiveDocument Set AcadMds = AcadDoc.ModelSpace Set AcadUtil = AcadDoc.Utility Set AcadPaperSpace = AcadDoc.PaperSpaceEnd Sub运行以上代码即可启动AutoCAD7.3 Visual Basic与Excel 的连接Visual Basic与Excel 的连接同Visual Basic与AutoCAD的连接，要使Visaul Basic的程序能调用Excel的命令、函数等，并在Excel中存取数据，首先要在Visaul Basic模块中申明一组对象。定义EXCEL空间Public ExcelApp As Excel.ApplicationPublic ExcelWBook As Excel.WorkbookPublic ExcelWSheet As Excel.WorksheetPublic ExcelShape As Excel.ShapesPublic ExcelChart As Excel.Chart连接ExcelPublic Sub qidongExcel() 连接EXCELOn Error Resume Next 忽略错误Set ExcelApp = GetObject(, Excel.Application) 查找一个正在运行的 Excel 拷贝If Err Then 如果 Excel 没有运行则 Err.Clear Set ExcelApp = CreateObject(Excel.Application) 运行它End IfEnd Sub运行以上代码启动Excel。7.4 自定义变量类型Public Type Tu 自定义一个记录数组 BianHao As String YanXing As String HouDu As Double MeiHao As String YinZi As Double PatName As StringEnd TypePublic Zhu_Zhuang(1 To 100) As Tu自定义存储柱状图数据变量Public Type Data_List_File 自定义一个记录数组 Excel_File As String File_Path As String Sheet_N As Integer Zhu_N As Integer BiaoGao As DoubleEnd TypePublic Ji_Lu(0 To 100) As Data_List_File 自定义记录柱状图文件路径及相关参数变量7.5 主要模块的编写本软件最重要的有两部分，一部分是从Excel存取数据，另一部分是在CAD中绘制柱状图。针对不同部分的功能在模块中编制了7个过程和两个函数。以下通过系统绘图的步骤来说明系统的实现过程，由于篇幅限制，不可能把所有代码全部列出，只列出一些重要的程序代码，以供参考。7.5.1 从Excel中取数据在VB和Excel建立连接后就可以利用VB程序对工作表进行操作、调用Excel里的数据，以下是定义一个子过程实现柱状图数据从Excel工作表到VB中自定义数组。Public Sub FuZhi(i As Integer) 把Excel里面的数据输入到数组Zhu_Zhuang()里面 On Error Resume Next Dim File_name As String 定义存储文件名的字符型变量 Dim File_Path As String 定义存储文件路径的字符型变量 Dim Excel_File As String 定义存储Excel文件名的字符型变量 Dim Zhu_N As Integer Dim Sheet_N As Integer Dim iROW As Integer Dim iCOL As Integer Dim K As Integer Dim j As Integer For K = 1 To i Excel_File = Ji_Lu(K).Excel_File File_Path = Ji_Lu(K).File_Path File_name = File_Path & / & Excel_File Sheet_N = Ji_Lu(K).Sheet_N Zhu_N = Ji_Lu(K).Zhu_N 以上为从记录数组中复制文件路径及相关变量 Set ExcelWBook = ExcelApp.Workbooks.Open(File_name) Set ExcelWSheet = ExcelApp.Sheets(Sheet_N)打开对应的Excel文件 iROW = 2 Do While Trim(ExcelWSheet.Cells(iROW, 1) With Zhu_Zhuang(iROW) .BianHao = ExcelWSheet.Cells(iROW, 1) .YanXing = ExcelWSheet.Cells(iROW, 2) .HouDu = ExcelWSheet.Cells(iROW, 3) .MeiHao = ExcelWSheet.Cells(iROW, 4) .YinZi = ExcelWSheet.Cells(iROW, 5) .PatName = RETURN_YanXing(.YanXing) End With iROW = iROW + 1 Loop从Excel文件中读取柱状图数据 Set ExcelWBook = Nothing Set ExcelWSheet = Nothing清空对象变量，为下次调用做准备 Next KEnd Sub7.5.2 绘图过程读取柱状图数据后最重要的就是绘制柱状图过程，下列代码完成绘制柱状图，主要是从柱状图数据记录变量中读取一组变量，再调用一个绘制柱状图子过程逐层绘制各层柱状。Public Sub HuiTu() On Error Resume Next 定义柱状图相关变量Dim YanXing As String Dim HouDu As Double Dim MeiHao As String Dim PatName As String Dim YinZi As Double Dim i As Integer Dim Height As Double 每层岩柱的起始高度 Dim BianHao As String 从柱状图数据记录数组中读取数据并绘制柱状图 i = 2 Height = 10 Do While Trim(Zhu_Zhuang(i).YanXing) With Zhu_Zhuang(i) BianHao = .BianHao YanXing = .YanXing HouDu = .HouDu MeiHao = .MeiHao YinZi = .YinZi PatName = .PatName End WithCall Ceng(i, Height, BianHao, YanXing, HouDu, MeiHao, YinZi, PatName) Height = Height + HouDu层岩柱高度累加 i = i + 1 Loop QK = i - 1End Sub7.5.3 画柱状图画岩柱框，这是画柱状图最基本的组成部分。Public Sub Ceng(Index As Integer, Height As Double, BianHao As String, YanXing As String, HouDu As Double, MeiHao As String, YinZi As Double, PatName As String) 用二维多段线画岩柱框 Dim ObjCengKuang As Object Dim Points(0 To 9) As Double Points(0) = 100: Points(1) = Height 1点坐标 Points(2) = Points(0) + KuanDu: Points(3) = Points(1) 2点坐标 Points(4) = Points(2): Points(5) = Points(3) + HouDu 3点坐标 Points(6) = Points(0): Points(7) = Points(1) + HouDu 4点坐标 Points(8) = Points(0): Points(9) = Points(1) 5点坐标 Set ObjCengKuang = AcadMds.AddLightWeightPolyline(Points) ObjCengKuang.Layer = 线条将岩柱框放到“线条”图层中 建立填充对象Set hatchObj = AcadMds.AddHatch(PatternType, PatName, bAssociativity) 编辑填充对象 hatchObj.Layer = 填充 hatchObj.PatternScale = YinZi hatchObj.HatchStyle = acHatchStyleIgnore hatchObj.Color = 160hatchObj.PatternAngle = 0定义填充外部边界Dim outerLoop(0 To 0) As AcadEntity创建填充外部边界 Set outerLoop(0) = ObjCengKuang hatchObj.AppendOuterLoop (outerLoop) hatchObj.EvaluateAcadDoc.Regen True显示充填实体End Sub运行完毕后，提示“柱状图绘制完毕”。程序代码见附录一8 系统存在的问题及改进意见由于时间有限，本软件的编制不够完善，以下是在编制过程中发现的一些问题及改进意见。1.AutoCAD里面自带的填充图案较少，有些填充图案跟实际图例有差距，解决方法是自定义填充图案。2.当柱状图部分岩层太厚时，所绘制的柱状图不协调、美观，改进方法是中间打断，标注厚度不变，减小柱状图的长度。3.当文字标注（岩性描述部分）较多时，文字易溢出框外。解决方法是先计算出字符变量中字符的个数，然后以此为基础，绘制岩性描述部分的图框。4.参数的自动检测功能有待进一步改进。参 考 文 献1 徐永忻.采矿学.徐州：中国矿业大学出版社，20032 徐永忻.煤矿开采学.徐州：中国矿业大学出版社，19993 林在康、左秀峰.矿业信息及计算机应用. 徐州：中国矿业大学出版社，20004 戴绍城.高产高效综合机械化采煤技术与装备.北京：煤炭工业出版社，19975 陈炎光、徐永祈.中国采煤方法.徐州：中国矿业大学出版社，19916 钱鸣高、刘听成.矿山压力及控制. 北京：煤炭工业出版社，19917 于海勇.放顶煤开采的基础理论. 北京：煤炭工业出版社，19958 王省身.矿井灾害防治理论与技术. 徐州：中国矿业大学出版社，19899 刘吉昌.煤矿施工设计基础.太原：山西人民出版社，198310 岑传鸿.采场顶板控制与检测技术. 徐州：中国矿业大学出版社，199811 蒋国安、吕家立.采矿工程英语. 徐州：中国矿业大学出版社，199812 李位民.特大型现代化矿井建设与工程实践. 北京：煤炭工业出版社，200113 综采设备管理手册编委会.综采设备管理手册. 北京：煤炭工业出版社，199414 能源部.煤矿安全规程. 北京：煤炭工业出版社，199215 中国煤矿专用设备成套服务公司.采煤机械化成套设备参考手册.煤炭工业部. 北京：煤炭工业出版社，198416 刘吉昌.煤矿施工设计基础. 太原：山西人民出版社，198317 中国统配煤矿总公司物资供应局.煤炭工业设备手册. 徐州：中国矿业大学出版社，199218 章玉华.技术经济学. 徐州：中国矿业大学出版社，199519 综采设备管理手册. 北京：煤炭工业出版社，1994附录一柱状图自动绘制软件原代码。模板中代码Public AcadApp As Object 定义AutoCAD对象Public AcadDoc As ObjectPublic AcadMds As ObjectPublic AcadUtil As ObjectPublic WenZi As Object 定义图层Public TianChong As ObjectPublic XianTiao As ObjectPublic QiTa As ObjectPublic ExcelApp As Excel.Application 定义EXCEL空间Public ExcelWBook As Excel.WorkbookPublic ExcelWSheet As Excel.WorksheetPublic ExcelShape As Excel.ShapesPublic ExcelChart As Excel.ChartPublic Ln As Object 定义基线Public KuanDu As Double 定义一些初试变量Public JianJu As DoublePublic BiLi As DoublePublic BiLi_a As DoublePublic BiLi_b As DoublePublic XuHao As DoublePublic DiBanBG As DoublePublic Zhu_N As DoublePublic Sheet_N As DoublePublic Type Tu 自定义一个记录数组 BianHao As String YanXing As String HouDu As Double MeiHao As String YinZi As Double PatName As StringEnd TypePublic Zhu_Zhuang(1 To 100) As TuPublic Type Data_List_File 自定义一个记录数组 Excel_File As String File_Path As String Sheet_N As Integer Zhu_N As Integer BiaoGao As DoubleEnd TypePublic Ji_Lu(0 To 100) As Data_List_FilePublic ShuMu As Integer 定义存储画柱状图个数的变量Public QK As Integer 定义清空数组时的公用变量Public Sub qidongCAD() 连接CAD On Error Resume Next Set AcadApp = GetObject(, autocad.application) If Err Then Set AcadApp = CreateObject(autocad.application) End If Set AcadDoc = AcadApp.ActiveDocument Set AcadMds = AcadDoc.ModelSpace Set AcadUtil = AcadDoc.Utility Set AcadPaperSpace = AcadDoc.PaperSpace Set WenZi = AcadDoc.Layers.Add(文字) Set TianCH = AcadDoc.Layers.Add(填充) Set XianTiao = AcadDoc.Layers.Add(线条) Set QiTa = AcadDoc.Layers.Add(其他)End SubPublic Sub qidongExcel() 连接EXCEL On Error Resume Next 忽略错误 Set ExcelApp = GetObject(, Excel.Application) 查找一个正在运行的 Excel 拷贝 If Err Then 如果 Excel 没有运行则 Err.Clear Set ExcelApp = CreateObject(Excel.Application) 运行它 If Err Then Dim ErrMsg As String ErrMsg = 错误号： & Err.Number & Chr(13) & Chr(10) ErrMsg = ErrMsg & 错误描述： & Err.Description Call 出错记录(ErrMsg) MsgBox Err.Description End End If End IfEnd SubPublic Sub readTxt() 读取参数 KuanDu = Val(Form1.Text1.Text) JianJu = Val(Form1.Text2.Text) BiLi_a = Val(Form1.Text3.Text) BiLi_b = Val(Form1.Text4.Text) XuHao = Val(Form1.TextXuhao.Text) DiBanBG = Val(Form1.TextBiaogao.Text) BiLi = BiLi_a / BiLi_bEnd SubPublic Sub HuiTu() On Error Resume Next 忽略错误 Dim YanXing As String Dim HouDu As Double Dim MeiHao As String Dim PatName As String Dim YinZi As Double Dim i As Integer Dim Height As Double Dim BianHao As String i = 2 Height = 10 Do While Trim(Zhu_Zhuang(i).YanXing) With Zhu_Zhuang(i) BianHao = .BianHao YanXing = .YanXing HouDu = .HouDu MeiHao = .MeiHao YinZi = .YinZi PatName = .PatName End With Call Ceng(i, Height, BianHao, YanXing, HouDu, MeiHao, YinZi, PatName) Height = Height + HouDu i = i + 1 Loop QK = i - 1End Sub窗体中代码Public Excel_Name As StringPublic Sheet_name As StringDim a As DoublePrivate Sub Command1_Click() Call qidongCAD MsgBox 现在运行 + AcadApp.Name + 版本号 + AcadApp.Version AcadApp.Visible = TrueEnd SubPrivate Sub Command2_Click() Call qidongCAD ShuMu = ShuMu + 1 Call HuiTu Dim i As Integer For i = 1 To QK With Zhu_Zhuang(i) .BianHao = .YanXing = .HouDu = 0 .MeiHao = .YinZi = 0 .PatName = End With Next i MsgBox 柱状图 绘制完毕！, vbInformation + vbOKOnly, 采软中心 AcadApp.Visible = True ZoomAllEnd SubPrivate Sub Command3_Click() Set AcadApp = Nothing Set AcadDoc = Nothing Set AcadMds = Nothing Set AcadUtil = Nothing Set AcadPaperSpace = Nothing Set ExcelApp = Nothing Set ExcelBook = Nothing Set ExcelSheet = Nothing Set ExcelShape = Nothing Set ExcelChart = Nothing End Unload MeEnd SubPrivate Sub Command4_Click() Call qidongExcel Set ExcelWBook = ExcelApp.Workbooks.Add ExcelApp.Visible = True Worksheets(Sheet1).Activate Worksheets(Sheet1).Cells(1, 1).Value = 编号 Worksheets(Sheet1).Cells(1, 2).Value = 岩层名称或煤层 Worksheets(Sheet1).Cells(1, 3).Value = 厚度 Worksheets(Sheet1).Cells(1, 4).Value = 煤号 Worksheets(Sheet1).Cells(1, 5).Value = 充填比例End SubPrivate Sub Command5_Click() Call readTxt Dim Sheet_N As Integer Sheet_N = Sheet_List.ListIndex + 1 Dim Zhu_N As Integer Zhu_N = Val(TextXuhao.Text) If Zhu_N = 0 Then Zhu_N = 1 End If Dim Excel_File As String Excel_File = File1.FileName With Ji_Lu(Zhu_N) .Excel_File = Excel_File .File_Path = File1.Path .Sheet_N = Sheet_N .Zhu_N = Zhu_N .BiaoG