在Mapgis建库过程中,有时候需要将离某个点最近的注释读取并写入到属性中去。如下图所示,点A,,点B需要分别将标注1和标注2的内容读取并写入到属性中去。
Mapgis组件开发提供了PntArea.Near 用来查找最近的点。初步的思路打算利用该方法进行查找。
首先,获取点A的坐标(xy),然后利用该坐标查找最近的标注。思路是没问题,但是利用PntArea.Near 查找时,却找不到标注。原来PntArea.Near(xy)最后查找到的点还是点A,不过距离点A最近的点确实是点A,看来脑袋有点短路了,呵呵。
既然直接使用PntArea.Near 方法不成功,只能自己动手了。在MapGis提供了Query对象,其中的RectAskToList可以将指定矩形范围内的对象查找出来并输出到一个IDList中。如果使用该对象将指定范围内的点全部查找出来,再进一步筛选不仅可以实现需要的功能了吗?以下为实现的思路和方法
首先,初始化
定义点工作区对象
Dim pntAI As New PntArea
定义查找的矩形框的距离(边长的一般)
Dim fDis As Double
fDis=100
定义写入的字段名称
Dim sResultFld As String
sResultFld ="标注内容"
加载点文件
If Not pntAI.Load() Then
MsgBox ("点文件加载失败!")
Exit Sub
End If
然后,获取所有点的编号,并以这些点为中心进行查找
Dim pntList As IDList, pntNo As Long
Dim pntTxt As String, pntInf As Pnt_Info, xy As D_Dot, pAtt As Record
Dim pntTxt1 As String, pntInf1 As Pnt_Info, xy1 As D_Dot, pntNo1 As Long
Dim pntDis As Double, MinDis As Double
Dim i As Long, j As Long
获取所有的点的编号
Set pntList = pntAI.GetAllExistNo()
定义Query对象
Dim Qfind As New Query
Qfind.sourceArea = pntAI
Dim Drect As New D_Rect, pntList1 As IDList, resultPntNo As Long
For i = 0 To pntList.Count - 1
pntNo = pntList(i)
pntAI.Get pntNo, xy, pntTxt, pntInf
限定点的类型不是非注释时进行查找
If pntInf.Type <> gisPNT_NOTE Then
Drect.xmin = xy.x - fDis
Drect.ymin = xy.y - fDis
Drect.xmax = xy.x + fDis
Drect.ymax = xy.y + fDis
Set pntList1 = Qfind.RectAskToList(gisPNT_ENTITY, Drect)
对找到的点,进行筛选,剔除点自身以及非注释的点
For j = pntList1.Count - 1 To 0 Step -1
pntNo1 = pntList1(j)
pntAI.GetInfo pntNo1, pntInf1
'Debug.Print pntInf1.Type
If pntInf.Type <> gisPNT_NOTE Or pntNo1 = pntNo Then
pntList1.Remove j, 1
End If
Next
查找距离最近的点
resultPntNo = -1
定义用于判断的最小距离,这里选定矩形框的边长作为最小距离
MinDis = fDis * 2
For j = 0 To pntList1.Count - 1
pntNo1 = pntList1(j)
pntAI.GetPos pntNo1, xy1
pntDis = MapGis.DistOfPntToPnt(xy, xy1)
If pntDis <= MinDis And pntDis > 0 Then
resultPntNo = pntNo1
MinDis = pntDis
End If
Next
根据resultPntNo 的值判断是否查找到点,如果找到,则写入属性
If resultPntNo > 0 Then
pntAI.Get resultPntNo, xy1, pntTxt1, pntInf1
If pntInf1.Type = gisPNT_NOTE Then
pntAI.att.Get pntNo, pAtt
pAtt.Value(sResultFld) = pntTxt1
pntAI.att.Write pntNo, pAtt
End If
End If
End If
Next
保存点对象
pntAI.Save
至此完成工作,检查下是否符合要求即可。以上代码使用vb6.0编写