一、前言
现在有很多绘制地形图以及平断面图的软件,地形图软件一般是在Autocad的平台上进行二次开发。平断面图则一般通过软件的操作平台,根据其数据文件生成可读写的DXF文件或是DWG文件,如道亨软件在图生成后常常还要进行必要的修改,修改中常常要进行重复繁琐的操作,对此利用VBA语言可以帮助我们完成这些工作。
二、地形图中的应用
(一)地形图的等高线失真原因
在测量的过程中,对于高差起伏比较大的地形,在内业过程中要进行等高线的绘制,但是在等高线的绘制过程中,读入原始测量数据建立DTM,三角网构建方式采用算法如图1所示:
1、在所采集的离散点中任意找一点,然后查找距此点最近的点,连接后作为初始基线。
2、在初始基线右侧搜寻第三点,具体的做法是:在初始基线右侧的离散点中查找距此基线距离最短的点,作为第三点。
3、生成Delaunay 三角形,再以三角形的两条新边(从基线起始点到第三点以及第三点到基线终止点)作为新的基线。
4、重复步骤2、3直至所有的基线处理。
因此三角网的连接的随机性、测量人员的跑点方式和实际地形的复杂程度共同造成了地形图的失真。如图2所示红色集水线所示为真实的沟底的走向,由于立尺人经验欠缺或是失误在没有E点采集数据,因此形成了图中B点与D点成一个深坑的形状,造成了地形图的失真,而用手工去修剪这样复杂的等高线常常需要修改三角网,但因为采用的线型及整体因素变得非常复杂而工作量相当的大。
(二)编写程序的过程
为了提高内业的工作效率,本人利用文件写入测量的原始数据,并利用软件重新绘制等高线。本人利用VBA读写测量的原始数据文件的,编制一个子过程即宏运行,编写的思路如下:
pfile = UserForm1.dd.FileName ‘调用一个窗体对话框,选择测量原始数据并进行文件写入
If pfile = "" Then
Exit Sub
End If
ThisDrawing.Utility.InitializeUserInput 0, "0 1 2 3"‘在CAD 命令提示行里选择坐标值位数
options = ThisDrawing.Utility.GetKeyword(vbCrLf & "选择坐标值的保留位数[零位(0)/一位(1)二位(2)/三位(3)]:")
pa = ThisDrawing.Utility.GetString(0, vbCrLf & "请你输入起始位置编号:")
’输入测量原始数据的序号
Open pfile For Append As #1
On Error GoTo dd
For kk = 1 To 1000
ca = ThisDrawing.Utility.GetString(0, vbCrLf & "请你输入内插高程:")
‘在命令提示符输入内插点的高程
wd = ThisDrawing.Utility.GetPoint(, "请你点取图面位置:") ‘获取当前选择点的图面坐标值
If options = "" Then 仅以不输入坐标位数取三位为例
ak1 = Format(wd(0), "0.000")
ak2 = Format(wd(1), "0.000")
ak3 = ca
end if
jj = (Trim(pa)) & ",," & ak1 & "," & ak2 & "," & ak3
pa = Str(Val(pa) + 1)
Print #1, jj
Next kk
Close #1
End Sub
(三)程序运行及结果
图2所示为内插红点所示的1211.33的标高后,计算机重新绘制等高线线后的地形图。一般在地形图成图软件中读入经过内插后的测量原始数据,重新形成三角网,并初步成等高线,同时检查三角网形成合理与否。对于地形起伏很大,沟壑较多的地方因为常常并不能一次就能够修改完毕,因此需要外业人员配合内业人员对原有的地形点进行加密,内插并重新形成与现场实地相符合的等高线。
三、平断面图中的应用
(一)平面中增加地物
平面中增加地物程序代码
选取某断面图运行该宏代码,显示结果如图4所示
jp = ThisDrawing.Utility.GetPoint(, "程序提示你选择平面中线点:")
jp1 = ThisDrawing.Utility.GetPoint(, "程序提示你选择起点:")
jp2 = ThisDrawing.Utility.GetPoint(, "程序提示你选择端点:")
di = jp2(0) - jp1(0)
ci = di / 30
b1(0) = jp1(0)
b1(1) = jp(1) - 5
For i = 0 To ci - 1
b1(0) = jp1(0) + i * 30 ‘ b1表示与插入旱地图元的位置
b1(1) = jp(1) - 5
Set blobj = ThisDrawing.ModelSpace.InsertBlock(b1, "E:\Program Files\AutoCAD 2004\tuk\hd.dwg", 1, 1, 1, 0)
blobj.color = acYellow
Next i
参考文献:
[1]刘大杰.实用测量数据处理方法[M].测绘出版社.