信息技术论文发表范文钻孔符号的绘制

　　目前，市场上流行的图形矢量化软件有很多，如CASS7.0等，这些软件大都是针对各类比例尺的地形图进行矢量化，带有各类地形图符号，对于大部分地形图矢量化可以满足要求，但对一些特殊要求的地形图矢量化却不适应，尤其是对其符号库需要另外进行扩充。由于各种专业的设计需要通常要把勘察任务中地质所布置的勘察孔位绘制在地形图上，并附上孔号及高程。而在我们常用的绘图软件CASS7.0 中所要提供的绘制钻孔符号功能中并不附带孔号及高程，需要手工完成。这大大增加了绘图人员的工作负担。

　　二、钻孔坐标展绘

　　AutoCAD得以在世界范围内流行的重要因素之一，是它的开放性，它将二次开发权交给了用户，并提供了许多开发工具。而VB是由微软公司推出的基于 Windows的可视化编程语言，它采用面向对象、事件驱动的程序设计方法，操作简便，因此倍受程序设计人员的青睐。下面就以如何展绘钻孔符号为例，介绍如何在 VB 6. 0环境下利用对ATUOCAD进行二次开发。

　　1、初始化。即要在VB中引用AutoCAD的类型库Acad.tlb，并建立VB与AutoCAD间的联系。相应的程序代码如下：

　　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

　　obj_Acad.Visible = True '设置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)语句来实现。

　　2、数据格式及比例尺选择。为方便使用，钻孔数据文件的格式与CASS展控制点数据格式相同，比例尺即与所成地形图比例尺相同，不同比例尺符号大小不同。格式及相关代码如下：点名,代码,东坐标,北坐标,高程

　　(图1钻孔数据格式) (图2选择数据格式界面)

　　With CommonDialog2

　　.DialogTitle = "选择展点文件(点名,代码,东坐标,北坐标,高程)"

　　.Filter = "CASS展点文件(*.DAT)|*.DAT" '钻孔数据文件的格式为方便使用此格式与CASS展控制点数据格式相同

　　.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、数据文件的读取及钻孔展绘。为便于查找所绘钻孔，新建图层”ZK”，并根据前面输入的比例尺先绘制好钻孔符号做成块，在从文件中顺序读取点号及高程并一起展绘出来。相关代码如下：

　　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"已经存在,直接获得,并跳出循环

　　End If

　　Next i

　　If Not panduan Then '如果图层不存在,建立图层

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

　　End If

　　'如果要设置该图层为当前图层,请添加下面的代码

　　obj_Doc.ActiveLayer = obj_layer '设置当前图层

　　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,填充图案是关联的,false,不关联

　　Dim outerloop(0 To 0) As Object, innerloop(0 To 0) As Object '定义填充图案的外边界和内边界

　　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 '系统默认是预定义

　　PatternName = "solid"

　　AssociativeHatch = True '设置填充图案是关联的

　　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)

　　'创建Hatch 对象

　　Set obj_hatch = blockObj.AddHatch(PatternType, PatternName, AssociativeHatch, 0) '0,图案填充;1,渐变色填充

　　obj_hatch.AppendOuterLoop outerloop '添加外边界,必须先创建Hatch 对象,才能定义边界

　　obj_hatch.AppendInnerLoop innerloop '添加内边界,必须先创建Hatch 对象,才能定义边界

　　obj_hatch.PatternScale = 0.2 '图案缩小后填充NumberOfLoops

　　obj_hatch.Evaluate '进行计算,生成填充图案

　　For i = 0 To obj_hatch.NumberOfLoops - 1 '遍历图案填充区域的边界,每条边界可能由数个对象组成

　　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 "没有设置此比例尺", 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 "请检查数据格式", 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展绘结果)

　　三、结束语

　　本文以展绘钻孔符号为例探讨了VB与AutoCAD的连接、展点的数据格式，以实现快速展绘钻孔。采用VB开发测绘系统的应用软件，只要处理好各设备之间的I/O接口操作、动态连接库的建立和调用及VB与数据库的接口、数据库的建立、数据格式之间的转换，就能在短时间内开发出界面友好的、功能易扩展的、面向对象的实时测控软件，满足测绘生产的需要。

　　[参考文献]

　　[1] 段兴.《Visual Basic6.0控件实用程序设计100例》.人民邮电出版社，2002.10

　　[2] 申石磊，季超 .《Visual Basic程序设计基础》. 高等教育出版社，2010.03

　　作者：张博(1982-)男，本科，辽宁西丰人，工程师，满族，研究方向：电力测绘查勘工作。
　　信息技术论文发表期刊推荐《信息技术与信息化》从信息技术的研究、应用角度展现IT行业与科技发展与进步，是全国高校、科研院所、企业发表信息科学研究、技术应用成果的园地。杂志内容以科技论文为主，并设有评论与综述、信息化论坛、网络通讯、信息处理与模式识别、研究与探索、方案与应用等栏目。