現(xiàn)在計算機上的繪圖軟件有很多，根據(jù)行業(yè)和不同的工作需要都有相應(yīng)的軟件來滿足用戶的需求。本文著重介紹的是鉆孔符號的繪制，應(yīng)該用哪些軟件，用到哪些技術(shù)等。文章是一篇信息技術(shù)論文發(fā)表范文。
　　摘要:介紹利用VB直接在AUTOCAD上展繪鉆孔符號，并附上設(shè)計程序。

　　關(guān)鍵詞:AutoCAD; VB

　　一、 前言

　　目前，市場上流行的圖形矢量化軟件有很多，如CASS7.0等，這些軟件大都是針對各類比例尺的地形圖進行矢量化，帶有各類地形圖符號，對于大部分地形圖矢量化可以滿足要求，但對一些特殊要求的地形圖矢量化卻不適應(yīng)，尤其是對其符號庫需要另外進行擴充。由于各種專業(yè)的設(shè)計需要通常要把勘察任務(wù)中地質(zhì)所布置的勘察孔位繪制在地形圖上，并附上孔號及高程。而在我們常用的繪圖軟件CASS7.0 中所要提供的繪制鉆孔符號功能中并不附帶孔號及高程，需要手工完成。這大大增加了繪圖人員的工作負擔。

　　二、 鉆孔坐標展繪

　　AutoCAD得以在世界范圍內(nèi)流行的重要因素之一，是它的開放性，它將二次開發(fā)權(quán)交給了用戶，并提供了許多開發(fā)工具。而VB是由微軟公司推出的基于 Windows的可視化編程語言，它采用面向?qū)ο�、事件�?qū)動的程序設(shè)計方法，操作簡便，因此倍受程序設(shè)計人員的青睞。下面就以如何展繪鉆孔符號為例，介紹如何在 VB 6. 0環(huán)境下利用對ATUOCAD進行二次開發(fā)。

　　1、初始化。即要在VB中引用AutoCAD的類型庫Acad.tlb，并建立VB與AutoCAD間的聯(lián)系。相應(yīng)的程序代碼如下：

　　Dim obj_Acad As Object, obj_Doc As Object, obj_ModelSpace As Object 'Application對象、Document對象、ModelSpace對象

　　Dim boo As Boolean

　　On Error Resume Next

　　Set obj_Acad = GetObject(, "autocad.application") '若AutoCAD已啟動,則直接得到Application對象,建議先打開CAD程序

　　If Err Then

　　Err.Clear

　　On Error Resume Next

　　Set obj_Acad = CreateObject("autocad.application") '若AutoCAD未啟動，則運行AutoCAD程序

　　If Err Then

　　Err.Clear

　　MsgBox "不能運行AutoCAD,請檢查是否安裝!", vbOKOnly, "警告!"

　　Exit Sub

　　End If

　　End If

　　obj_Acad.Visible = True '設(shè)置AutoCAD為可見(或者在后臺運行,不可見)

　　obj_Acad.Documents.Open (filename) '打開AutoCAD圖形文件

　　Set obj_Doc = obj_Acad.ActiveDocument '獲得當前活動圖形文件，即剛打開的圖形文件

　　Set obj_ModelSpace = obj_Doc.ModelSpace '獲得當前活動圖形文件的模型空間

　　boo = True

　　之后，即可以用AutoCAD類型庫提供的屬性、方法對AutoCAD進行操作，如畫線，可用

　　obj_ModelSpace.AddLine(startPoint, endpoint)語句來完成，寫文字，可用obj_ModelSpace.AddText(Format(gc(i), "0.0"), InsertionPoint, 2)語句來實現(xiàn)。

　　2、數(shù)據(jù)格式及比例尺選擇。為方便使用，鉆孔數(shù)據(jù)文件的格式與CASS展控制點數(shù)據(jù)格式相同，比例尺即與所成地形圖比例尺相同，不同比例尺符號大小不同。格式及相關(guān)代碼如下：點名,代碼,東坐標,北坐標,高程

　　(圖1鉆孔數(shù)據(jù)格式) (圖2選擇數(shù)據(jù)格式界面)

　　With CommonDialog2

　　.DialogTitle = "選擇展點文件(點名,代碼,東坐標,北坐標,高程)"

　　.Filter = "CASS展點文件(*.DAT)|*.DAT" '鉆孔數(shù)據(jù)文件的格式為方便使用此格式與CASS展控制點數(shù)據(jù)格式相同

　　.ShowOpen

　　If .filename = "" Then

　　MsgBox "未選擇展點文件!", vbOKOnly, "警告!"

　　Exit Sub

　　End If

　　If Dir(.filename) = "" Then

　　MsgBox "未找到展點文件!", vbOKOnly, "警告!"

　　Exit Sub

　　End If

　　blnLyr = False

　　'輸入比例尺

　　Dim blc As String

　　blc = InputBox("請輸入比例尺500:1000:2000", "比例尺", "500")

　　(圖3輸入比例尺)

　　3、數(shù)據(jù)文件的讀取及鉆孔展繪。為便于查找所繪鉆孔，新建圖層”ZK”，并根據(jù)前面輸入的比例尺先繪制好鉆孔符號做成塊，在從文件中順序讀取點號及高程并一起展繪出來。相關(guān)代碼如下：

　　For i = 0 To obj_Doc.Layers.Count - 1 '遍歷所有的圖層

　　If obj_Doc.Layers.Item(i).Name = "zk" Then

　　Set obj_layer = obj_Doc.Layers.Item("zk")

　　panduan = True

　　Exit For '如果"newblock"已經(jīng)存在,直接獲得,并跳出循環(huán)

　　End If

　　Next i

　　If Not panduan Then '如果圖層不存在,建立圖層

　　Set obj_layer = obj_Doc.Layers.Add("zk")

　　End If

　　'如果要設(shè)置該圖層為當前圖層,請?zhí)砑酉旅娴拇�碼

　　obj_Doc.ActiveLayer = obj_layer '設(shè)置當前圖層

　　obj_layer.Color = 1 '1 紅色;2 黃色;3 綠色;4 青色;5 藍色;6 紫色;7 白色(黑)

　　obj_Acad.ZoomExtents

　　'定義塊

　　Dim blockObj As Object

　　Dim insertionPnt(0 To 2) As Double

　　insertionPnt(0) = 0

　　insertionPnt(1) = 0

　　insertionPnt(2) = 0

　　Set blockObj = obj_Doc.Blocks.Add(insertionPnt, "zk")

　　' 向塊中添加鉆孔符號

　　Dim obj_circle1, obj_circle2, obj_circle3 As Object '定義圓對象

　　Dim center1(0 To 2) As Double, center2(0 To 2) As Double

　　Dim center3(0 To 2) As Double, point() As Double

　　Dim Radius As Double

　　Dim obj_hatch As Object '定義填充對象

　　Dim PatternType As Integer '圖案類型:1 預定義,0 用戶定義,2,自定義

　　Dim PatternName As String '填充圖案

　　Dim AssociativeHatch As Boolean 'true,填充圖案是關(guān)聯(lián)的,false,不關(guān)聯(lián)

　　Dim outerloop(0 To 0) As Object, innerloop(0 To 0) As Object '定義填充圖案的外邊界和內(nèi)邊界

　　Dim aloop As Variant

　　center3(0) = 0#: center3(1) = 0#: center3(2) = 0#

　　Set obj_circle2 = blockObj.AddCircle(center3, 0.25)

　　Set obj_circle3 = blockObj.AddCircle(center3, 0.001)

　　' 定義圖案填充

　　PatternType = 1 '系統(tǒng)默認是預定義

　　PatternName = "solid"

　　AssociativeHatch = True '設(shè)置填充圖案是關(guān)聯(lián)的

　　Set outerloop(0) = obj_circle2

　　Set innerloop(0) = obj_circle3

　　center1(0) = 0#: center1(1) = 0#: center1(2) = 0#

　　Radius = 0.75

　　Set obj_circle1 = blockObj.AddCircle(center1, Radius)

　　'創(chuàng)建Hatch 對象

　　Set obj_hatch = blockObj.AddHatch(PatternType, PatternName, AssociativeHatch, 0) '0,圖案填充;1,漸變色填充

　　obj_hatch.AppendOuterLoop outerloop '添加外邊界,必須先創(chuàng)建Hatch 對象,才能定義邊界

　　obj_hatch.AppendInnerLoop innerloop '添加內(nèi)邊界,必須先創(chuàng)建Hatch 對象,才能定義邊界

　　obj_hatch.PatternScale = 0.2 '圖案縮小后填充NumberOfLoops

　　obj_hatch.Evaluate '進行計算,生成填充圖案

　　For i = 0 To obj_hatch.NumberOfLoops - 1 '遍歷圖案填充區(qū)域的邊界,每條邊界可能由數(shù)個對象組成

　　obj_hatch.GetLoopAt i, aloop

　　Next i

　　Dim obj_line As Object '定義直線對象

　　Dim point1(0 To 2) As Double, point2(0 To 2) As Double, point3(0 To 2) As Double

　　point1(0) = 1.25: point1(1) = 0#: point1(2) = 0#

　　point2(0) = 7.25: point2(1) = 0#: point2(2) = 0#

　　Set obj_line = blockObj.AddLine(point1, point2)

　　' 打開文件并讀取

　　fileno = FreeFile

　　Open .filename For Input As fileno

　　Do While Not EOF(fileno)

　　Line Input #fileno, strline

　　If strDivide(strline, ",").Count = 5 Then

　　intCnt = intCnt + 1

　　dblPnt(0) = CDbl(strDivide(strline, ",").Data(2))

　　dblPnt(1) = CDbl(strDivide(strline, ",").Data(3))

　　dblPnt(2) = CDbl(strDivide(strline, ",").Data(4))

　　If blc = 500 Then

　　Xscale = 1: Yscale = 1: Zscale = 1

　　dblTxt(0) = dblPnt(0) + 4.25: dblTxt(1) = dblPnt(1) + 0.5: dblTxt(2) = dblPnt(2): height = 1.2

　　ElseIf blc = 1000 Then

　　Xscale = 2: Yscale = 2: Zscale = 2

　　dblTxt(0) = dblPnt(0) + 4.25 * 2: dblTxt(1) = dblPnt(1) + 0.5 * 2: dblTxt(2) = dblPnt(2): height = 1.2 * 2

　　ElseIf blc = 2000 Then

　　Xscale = 4: Yscale = 4: Zscale = 4

　　dblTxt(0) = dblPnt(0) + 4.25 * 4: dblTxt(1) = dblPnt(1) + 0.5 * 4: dblTxt(2) = dblPnt(2): height = 1.2 * 4

　　Else

　　MsgBox "沒有設(shè)置此比例尺", vbOKOnly, "比例尺?"

　　End

　　End If

　　Set objTxt = obj_ModelSpace.AddText(strDivide(strline, ",").Data(0), dblTxt, height)

　　objTxt.Alignment = acAlignmentCenter

　　objTxt.TextAlignmentPoint = dblTxt

　　objTxt.Update

　　Select Case blc

　　Case 500

　　dblTxt(1) = dblPnt(1) - 1.7

　　Case 1000

　　dblTxt(1) = dblPnt(1) - 1.7 * 2

　　Case 2000

　　dblTxt(1) = dblPnt(1) - 1.7 * 4

　　End Select

　　'插入塊

　　Dim blockRefObj As Object

　　Set blockRefObj = obj_Doc.ModelSpace.InsertBlock(dblPnt, "zk", Xscale, Yscale, Zscale, 0)

　　'插入高程

　　Set objTxt = obj_Doc.ModelSpace.AddText(strDivide(strline, ",").Data(4), dblTxt, height)

　　objTxt.Alignment = acAlignmentCenter

　　objTxt.TextAlignmentPoint = dblTxt

　　Else

　　MsgBox "請檢查數(shù)據(jù)格式", vbOKOnly, "CASS格式?"

　　End

　　End If

　　Loop

　　Close fileno

　　End With

　　obj_Doc.Regen acActiveViewport

　　obj_Acad.ZoomAll

　　obj_Doc.Utility.Prompt vbCr & "展點完畢,共展點" & intCnt & "個。"

　　MsgBox "已完成!", vbOKOnly, ""

　　End Sub

　　(圖4展繪結(jié)果)

　　三、 結(jié)束語

　　本文以展繪鉆孔符號為例探討了VB與AutoCAD的連接、展點的數(shù)據(jù)格式，以實現(xiàn)快速展繪鉆孔。采用VB開發(fā)測繪系統(tǒng)的應(yīng)用軟件，只要處理好各設(shè)備之間的I/O接口操作、動態(tài)連接庫的建立和調(diào)用及VB與數(shù)據(jù)庫的接口、數(shù)據(jù)庫的建立、數(shù)據(jù)格式之間的轉(zhuǎn)換，就能在短時間內(nèi)開發(fā)出界面友好的、功能易擴展的、面向?qū)ο蟮膶崟r測控軟件，滿足測繪生產(chǎn)的需要。

　　[參考文獻]

　　[1] 段興.《Visual Basic6.0控件實用程序設(shè)計100例》.人民郵電出版社，2002.10

　　[2] 申石磊，季超 .《Visual Basic程序設(shè)計基礎(chǔ)》. 高等教育出版社，2010.03

　　作者：張博(1982-)男，本科，遼寧西豐人，工程師，滿族，研究方向：電力測繪查勘工作 。
　　信息技術(shù)論文發(fā)表期刊推薦《信息技術(shù)與信息化》從信息技術(shù)的研究、應(yīng)用角度展現(xiàn)IT行業(yè)與科技發(fā)展與進步，是全國高校、科研院所、企業(yè)發(fā)表信息科學研究、技術(shù)應(yīng)用成果的園地。雜志內(nèi)容以科技論文為主，并設(shè)有評論與綜述、信息化論壇、網(wǎng)絡(luò)通訊、信息處理與模式識別、研究與探索、方案與應(yīng)用等欄目。

---

轉(zhuǎn)載請注明來自：http://www.jinnzone.com/jisuanjixinxiguanlilw/53412.html