專題-柱狀圖繪制軟件

柱狀圖繪制軟件摘 要本系統(tǒng)通過利用VB編程從Excel中讀取數(shù)據(jù)，在AutoCAD中實現(xiàn)自動繪制柱狀圖，具有一定實用性。關(guān)鍵詞CAD二次開發(fā) 柱狀圖 VB Excel 1 概述隨著科學的發(fā)展，計算機在采礦領(lǐng)域的應用應用已越來越廣，其中一個重要的應用方向就是計算機輔助制圖（CAD）。在煤炭行業(yè)，CAD的應用已相當普遍，但制圖自動化程度較低，生產(chǎn)、設計單位也缺少這方面的軟件，由此給我們一個思路，通過編程實現(xiàn)繪圖的自動化。Autodesk公司的AutoCAD是當今世界上最暢銷的繪圖軟件之一，已成為廣大工程技術(shù)人員最好的設計助手。它具有強大的繪圖功能，同時，具有開放性，用戶可以根據(jù)自己的實際需要及專業(yè)性質(zhì)，對CAD進行二次開發(fā)，從而更加完善地為本專業(yè)服務，這也是CAD受歡迎的重要原因之一。Mcrosoft公司的Visual Basic6.0是當今最暢銷的編程語言之一，為軟件開發(fā)者提供了良好的開發(fā)環(huán)境；簡單易學，功能強大。而CAD內(nèi)部的VBA開發(fā)工具，使以上兩套功能強大的軟件可以無間隙地結(jié)合在一起，讓用戶可以很輕松地開發(fā)出自己滿意的軟件。為此采用AutoCAD的ActiveX技術(shù)及Visual Basic 6.0、Mcrosoft Excel來編制軟件。柱狀圖是采礦制圖中需經(jīng)常繪制的一部分，且柱狀圖具有較大的相似性，為其自動處理提供了可能。下面介紹的就是用VB對CAD進行二次開發(fā)，繪制柱狀圖的軟件。2 系統(tǒng)目標用戶選擇已輸入數(shù)據(jù)的Excel文件，并設置了相應參數(shù)或采取默認值以后，系統(tǒng)自動完成柱狀圖的繪制，并進行標注。為了做到功能全面，操作簡單，要求系統(tǒng)能達到這樣的要求：當用戶改變某一參數(shù)（如柱狀圖的寬度）時，系統(tǒng)對其它參數(shù)進行自動調(diào)整，努力使柱狀圖諧調(diào)，美觀，使“柱狀圖繪制”做到真正的“自動化”。這一點是整個系統(tǒng)設計的重點與難點。3 設計原則本系統(tǒng)的設計應按軟件工程的步驟一步步進行，不應盲目進入代碼編制階段，首先看有關(guān)資料，進行練習，完成必要的技術(shù)儲備，然后進行系統(tǒng)的總體設計、詳細設計，接著才是編碼階段，最后反復調(diào)試，使之能達到預期的要求。4 設計思想由于柱狀圖的畫法基本一致，故本程序?qū)⒅鶢顖D的各個組成部分，等的繪制編制成函數(shù)或子過程，當選擇不同類型的巷道時，調(diào)用相應的函數(shù)或子過程，完成柱狀圖的自動繪制。同時，各個函數(shù)或子過程可隨著柱狀圖參數(shù)的變化（如柱狀圖寬度的不同）繪制出不同的柱狀圖。5 程序流程圖圖5.1 程序流程圖6 系統(tǒng)介紹6.1 系統(tǒng)功能本系統(tǒng)能在AutoCAD環(huán)境中自動完成柱狀圖的繪制，并標注各巖層性質(zhì)，并能根據(jù)用戶設置的主要參數(shù)（如寬度）來自動調(diào)整和改變柱狀圖的形狀，使柱狀圖協(xié)調(diào)、美觀。圖6.程序界面6.2 界面介紹1.用戶首先需要選擇保存有柱狀圖數(shù)據(jù)的Excel文件。單擊驅(qū)動器列表框，則目錄列表框列出當前驅(qū)動器中的文件。2.在目錄列表框中單擊柱狀圖數(shù)據(jù)文件所在的文件夾，則在文件列表框列出該文件夾包含的所有保存有柱狀圖數(shù)據(jù)的Excel文件。3.單擊文件名則程序?qū)⒆詣哟蜷_該Excel文件，并將該文件內(nèi)的所有工作表的名稱在列表框中列出。4.單擊列表框中的工作表，在窗體右上方的OLE控件中顯示該工作表中的內(nèi)容，便于用戶核對數(shù)據(jù)，同時“添加”按鈕變?yōu)榭捎?。用戶也可以通過雙擊該控件，打開對應的Excel工作表，更改數(shù)據(jù)后保存，重復以上步驟即可繼續(xù)繪圖。如果用戶想重新輸入數(shù)據(jù)，還可以單擊“重新輸入數(shù)據(jù)”按鈕，打開新的工作表，輸入完成后保存，重復以上步驟即可繼續(xù)繪圖。OLE控件顯示數(shù)據(jù)表如圖6.2。圖6.2 OLE控件顯示Excel表界面5.單擊“添加”按鈕程序自動讀取所選Excel工作表中數(shù)據(jù)并存儲。同時在Date控件中顯示文件名及對應柱狀圖序號。6.單擊“啟動”按鈕，打開AutoCAD，這一步可以忽略，而直接繪圖。7.單擊“繪圖”按鈕程序自動完成柱狀圖的繪制并提示繪制完成。繪制完效果圖如圖6.3。8.單擊“退出”按鈕結(jié)束程序，并清空對象，釋放占用空間。7 系統(tǒng)編制過程7.1 引用各類的庫要實現(xiàn)用Visual Basic語言對AutoCAD的二次開發(fā)，首先要用倒的是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的二次開發(fā)，就要使Visaul Basic的程序能調(diào)用CAD的命令并能在CAD的環(huán)境下由程序控制進行自動繪圖。首先在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的程序能調(diào)用Excel的命令、函數(shù)等，并在Excel中存取數(shù)據(jù)，首先要在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 自定義一個記錄數(shù)組 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自定義存儲柱狀圖數(shù)據(jù)變量Public Type Data_List_File 自定義一個記錄數(shù)組 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 自定義記錄柱狀圖文件路徑及相關(guān)參數(shù)變量7.5 主要模塊的編寫本軟件最重要的有兩部分，一部分是從Excel存取數(shù)據(jù)，另一部分是在CAD中繪制柱狀圖。針對不同部分的功能在模塊中編制了7個過程和兩個函數(shù)。以下通過系統(tǒng)繪圖的步驟來說明系統(tǒng)的實現(xiàn)過程，由于篇幅限制，不可能把所有代碼全部列出，只列出一些重要的程序代碼，以供參考。7.5.1 從Excel中取數(shù)據(jù)在VB和Excel建立連接后就可以利用VB程序?qū)ぷ鞅磉M行操作、調(diào)用Excel里的數(shù)據(jù)，以下是定義一個子過程實現(xiàn)柱狀圖數(shù)據(jù)從Excel工作表到VB中自定義數(shù)組。Public Sub FuZhi(i As Integer) 把Excel里面的數(shù)據(jù)輸入到數(shù)組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 以上為從記錄數(shù)組中復制文件路徑及相關(guā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文件中讀取柱狀圖數(shù)據(jù) Set ExcelWBook = Nothing Set ExcelWSheet = Nothing清空對象變量，為下次調(diào)用做準備 Next KEnd Sub7.5.2 繪圖過程讀取柱狀圖數(shù)據(jù)后最重要的就是繪制柱狀圖過程，下列代碼完成繪制柱狀圖，主要是從柱狀圖數(shù)據(jù)記錄變量中讀取一組變量，再調(diào)用一個繪制柱狀圖子過程逐層繪制各層柱狀。Public Sub HuiTu() On Error Resume Next 定義柱狀圖相關(guān)變量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 從柱狀圖數(shù)據(jù)記錄數(shù)組中讀取數(shù)據(jù)并繪制柱狀圖 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創(chuàng)建填充外部邊界 Set outerLoop(0) = ObjCengKuang hatchObj.AppendOuterLoop (outerLoop) hatchObj.EvaluateAcadDoc.Regen True顯示充填實體End Sub運行完畢后，提示“柱狀圖繪制完畢”。程序代碼見附錄一8 系統(tǒng)存在的問題及改進意見由于時間有限，本軟件的編制不夠完善，以下是在編制過程中發(fā)現(xiàn)的一些問題及改進意見。1.AutoCAD里面自帶的填充圖案較少，有些填充圖案跟實際圖例有差距，解決方法是自定義填充圖案。2.當柱狀圖部分巖層太厚時，所繪制的柱狀圖不協(xié)調(diào)、美觀，改進方法是中間打斷，標注厚度不變，減小柱狀圖的長度。3.當文字標注（巖性描述部分）較多時，文字易溢出框外。解決方法是先計算出字符變量中字符的個數(shù)，然后以此為基礎，繪制巖性描述部分的圖框。4.參數(shù)的自動檢測功能有待進一步改進。參 考 文 獻1 徐永忻.采礦學.徐州：中國礦業(yè)大學出版社，20032 徐永忻.煤礦開采學.徐州：中國礦業(yè)大學出版社，19993 林在康、左秀峰.礦業(yè)信息及計算機應用. 徐州：中國礦業(yè)大學出版社，20004 戴紹城.高產(chǎn)高效綜合機械化采煤技術(shù)與裝備.北京：煤炭工業(yè)出版社，19975 陳炎光、徐永祈.中國采煤方法.徐州：中國礦業(yè)大學出版社，19916 錢鳴高、劉聽成.礦山壓力及控制. 北京：煤炭工業(yè)出版社，19917 于海勇.放頂煤開采的基礎理論. 北京：煤炭工業(yè)出版社，19958 王省身.礦井災害防治理論與技術(shù). 徐州：中國礦業(yè)大學出版社，19899 劉吉昌.煤礦施工設計基礎.太原：山西人民出版社，198310 岑傳鴻.采場頂板控制與檢測技術(shù). 徐州：中國礦業(yè)大學出版社，199811 蔣國安、呂家立.采礦工程英語. 徐州：中國礦業(yè)大學出版社，199812 李位民.特大型現(xiàn)代化礦井建設與工程實踐. 北京：煤炭工業(yè)出版社，200113 綜采設備管理手冊編委會.綜采設備管理手冊. 北京：煤炭工業(yè)出版社，199414 能源部.煤礦安全規(guī)程. 北京：煤炭工業(yè)出版社，199215 中國煤礦專用設備成套服務公司.采煤機械化成套設備參考手冊.煤炭工業(yè)部. 北京：煤炭工業(yè)出版社，198416 劉吉昌.煤礦施工設計基礎. 太原：山西人民出版社，198317 中國統(tǒng)配煤礦總公司物資供應局.煤炭工業(yè)設備手冊. 徐州：中國礦業(yè)大學出版社，199218 章玉華.技術(shù)經(jīng)濟學. 徐州：中國礦業(yè)大學出版社，199519 綜采設備管理手冊. 北京：煤炭工業(yè)出版社，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 自定義一個記錄數(shù)組 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 自定義一個記錄數(shù)組 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 定義存儲畫柱狀圖個數(shù)的變量Public QK As Integer 定義清空數(shù)組時的公用變量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() 讀取參數(shù) 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 現(xiàn)在運行 + 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