query.frm

mapgis二次开发,vb示例 mapgis二次开发,vb示例

'使用Query对象之前一定要先设置源工作区
    objQuery.sourceArea = NetAi
Else
    Set NetAi = Nothing
    Exit Sub
End If

'构造矩形（此处应由开发者决定）
Set frc = New D_Rect
frc.xmin = 100
frc.xmax = 500
frc.ymin = 100
frc.ymax = 500

'判断某号网络是否与矩形框相交如下：
'判断网络1是否与矩形相交，这里相交是指：
'网络的网段与矩形框相交，或者整个网络被矩形框包含
nRes = objQuery.NetCrossRect(1, frc)
If nRes Then
MsgBox "网络1与矩形相交！"
End If

'判断已知网络是否与矩形相交
'先取网络1
If NetAi.Get(1, ndat, NetInfo) Then
'再判断
nRes = objQuery.NetInterRect(ndat, frc)
End If
If nRes Then
MsgBox "网络1与矩形相交！"
End If

'若考虑网络范围，则可如下：
'Set nrc = NetAi.rect
'nRes = objQuery.NetInterRect(ndat, frc, nrc)

Set frc = Nothing
'Set nrc = Nothing
Set ndat = Nothing
Set NetAi = Nothing
Set NetInfo = Nothing
End Sub

Private Sub NetAndRegPos_Click()
'判断网络是否在区域内
Dim NetAi As NetArea
Dim RegAi As RegArea
Dim rdat As LONGList
Dim rxy As D_DotSet
Dim ne As LONGList
Dim inf As Reg_Info

Set NetAi = New NetArea
If NetAi.Load Then
'使用Query对象之前一定要先设置源工作区
    objQuery.sourceArea = NetAi
Else
    Set NetAi = Nothing
    Exit Sub
End If

Set RegAi = New RegArea
If Not RegAi.Load Then
    Set NetAi = Nothing
    Set RegAi = Nothing
Exit Sub
End If
'以下判断网络1是否与区1相交(方法一)
nRes = objQuery.NetInterReg(1, RegAi, 1)
If nRes Then
MsgBox "网络1与区1相交!"
End If

'以下判断网络1是否与区1相交(方法二)
'首先取得区域1信息：
If RegAi.Get(1, rdat, inf) Then
'再取得区1边界坐标
nRes = RegAi.GetEdge(rdat, rxy, ne)
End If

'最后判断网络1是否与区1相交
nRes = objQuery.NetInterReg1(1, rxy, ne)
If nRes Then
MsgBox "网络1与区1相交!"
End If

Set ne = Nothing
Set rxy = Nothing
Set inf = Nothing
Set rdat = Nothing
Set RegAi = Nothing
Set NetAi = Nothing
End Sub

Private Sub PntAndRectPos_Click()
'点与矩形范围的位置关系
Dim pnt As D_Dot
Dim frc As D_Rect
Dim PntAi As PntArea

Set PntAi = New PntArea
If PntAi.Load Then
'使用Query对象之前一定要先设置源工作区
    objQuery.sourceArea = PntAi
Else
    Set PntAi = Nothing
    Exit Sub
End If

'构造矩形（此处应由开发者决定）
Set frc = New D_Rect
frc.xmin = 100
frc.xmax = 500
frc.ymin = 100
frc.ymax = 500

'点与矩形范围的位置关系 返回值：2/1/0=内/边界/外
'如下: 判断点1与frc的位置关系
nRes = PntAi.GetPos(100, pnt)
If nRes Then
nRes = objQuery.PntInRect(pnt, frc)
End If

Select Case nRes
Case 0
    MsgBox "点在矩形外！"
Case 1
    MsgBox "点在矩形上！"
Case 2
    MsgBox "点在矩形内！"
Case Else
    MsgBox "返回值不正确！"
End Select

Set pnt = Nothing
Set frc = Nothing
Set PntAi = Nothing
End Sub

Private Sub QueryNearEntity_Click()
'包括查找最近点，最近结点，最近线
Dim xy As D_Dot
Dim LayPad As LayerOnOffPad
Dim rtnDis As Double
Dim PntAi As PntArea
Dim LinAi As LinArea
Dim RegAi As New RegArea

Set PntAi = New PntArea
If PntAi.Load Then
'使用Query对象之前一定要先设置源工作区
    objQuery.sourceArea = PntAi
Else
    Exit Sub
End If

Set xy = New D_Dot
xy.x = 100
xy.y = 100

'查找最近的点
lRes = objQuery.NearPnt(xy, , rtnDis)
MsgBox "最近的点号为：" & lRes & "距离为：" & rtnDis
'若打开图层开关，则如下：
Set LayPad = New LayerOnOffPad
LayPad.SetAllOn '打开所有图层
lRes = objQuery.NearPnt(xy, LayPad, rtnDis)

Set LinAi = New LinArea
If LinAi.Load Then
'使用Query对象之前一定要先设置源工作区
    objQuery.sourceArea = LinAi
Else
    Exit Sub
End If

'查找最近的线
lRes = objQuery.NearLin(xy, LayPad, rtnDis)
MsgBox "最近的线号为：" & lRes & "距离为：" & rtnDis

'查找最近的结点
lRes = objQuery.NearNod(xy, rtnDis)
MsgBox "最近的结点号为：" & lRes & "距离为：" & rtnDis


Set xy = Nothing
Set PntAi = Nothing
Set LinAi = Nothing
Set RegAi = Nothing
Set LayPad = Nothing
End Sub

Private Sub RectAskToArea_Click()
'矩形范围查询图元，返回图元表
Dim rect As New D_Rect
Dim RegAi As New RegArea
Dim LayPad As LayerOnOffPad
Dim ai1 As New RegArea

If RegAi.Load Then
'使用Query对象之前一定要先设置源工作区属性
objQuery.sourceArea = RegAi
Else: Exit Sub
End If

rect.xmin = 100
rect.xmax = 500
rect.ymin = 100
rect.ymax = 500

Set LayPad = New LayerOnOffPad
LayPad.SetAllOn

'查询结果存入到目的工作区ai1，注意：源工作区和目的工作区必须
'是同类型的,但是类型可以不同，对应关系如下：
'源工作区类型   REG        LIN    PNT      NET
'类型值范围 REG,LIN,NOD||LIN,NOD||PNT||NET,LIN,NOD
lRes = objQuery.RectAskToArea(gisLIN_ENTITY, rect, ai1)
ai1.SaveAs
'若打开层开关板则如下：
lRes = objQuery.RectAskToArea(gisLIN_ENTITY, rect, ai1, LayPad)

Set ai1 = Nothing
Set rect = Nothing
Set RegAi = Nothing
Set LayPad = Nothing
End Sub

Private Sub RectAskToList_Click()
'矩形范围查询图元，返回图元表
Dim rect As New D_Rect
Dim RegAi As New RegArea
Dim LayPad As LayerOnOffPad
Dim ai1 As New RegArea

If RegAi.Load Then
'使用Query对象之前一定要先设置源工作区属性
objQuery.sourceArea = RegAi
Else: Exit Sub
End If

rect.xmin = 100
rect.xmax = 500
rect.ymin = 100
rect.ymax = 500

Set LayPad = New LayerOnOffPad
LayPad.SetAllOn

'查询结果存入到目的工作区ai1，注意：源工作区和目的工作区必须
'是同类型的,但是类型可以不同，对应关系如下：
lRes = objQuery.RectAskToArea(gisLIN_ENTITY, rect, ai1)
ai1.SaveAs
'若打开层开关板则如下：
lRes = objQuery.RectAskToArea(gisLIN_ENTITY, rect, ai1, LayPad)

Set ai1 = Nothing
Set rect = Nothing
Set RegAi = Nothing
Set LayPad = Nothing

End Sub

Private Sub RegAndRectPos_Click()
'判断区是否与矩形范围相交
Dim rc As D_Rect
Dim RegAi As RegArea
Dim rdat As LONGList
Dim inf As Reg_Info
Dim count As Long

Set RegAi = New RegArea
If RegAi.Load Then
'使用Query对象之前一定要先设置源工作区属性
objQuery.sourceArea = RegAi
Else
Set RegAi = Nothing
Exit Sub
End If

'矩形范围（给定）
Set rc = New D_Rect
rc.xmax = 500
rc.xmin = 50
rc.ymax = 500
rc.ymin = 50

'1. 判断已知区是否与矩形范围相交
'以下找出所有与矩形相交的区域
For count = 1 To RegAi.count - 1
    nRes = objQuery.RegCrossRect(count, rc)
    If nRes Then
    MsgBox "区" & count & "与矩形框相交！"
    End If
Next count

'//////////////
If RegAi.Get(1, rdat, inf) Then
    For count = 1 To 100
    '首先取得区信息
        nRes = objQuery.RegInterRect(rdat, rc)
    Next count
End If
'//////////////

'2. 判断某号区域是否与矩形框相交
'以下找出所有与矩形相交的区域
For count = 1 To RegAi.count - 1
'首先取得区信息
If RegAi.Get(count, rdat, inf) Then
    nRes = objQuery.RegInterRect(rdat, rc)
    Set rdat = Nothing
    Set inf = Nothing
End If
If nRes Then
    MsgBox "区" & count & "与矩形框相交！"
End If
Next count

'如若考虑区矩形范围，则如下：
'Set rrc = RegAi.rect
'nRes = objQuery.RegInterRect(rdat, rc, rrc)

Set rc = Nothing
Set RegAi = Nothing
End Sub

Private Sub RegAskQuery_Click()
Dim RegAi As New RegArea
Dim ai1 As RegArea
Dim ai2 As RegArea
Dim objIDList As IDList
Dim outflg As Integer
If RegAi.Load Then
'使用Query对象之前一定要先设置源工作区属性
objQuery.sourceArea = RegAi
Else: Exit Sub
End If

Set ai1 = New RegArea
If Not ai1.Load Then
Set RegAi = Nothing
Exit Sub
End If

outflg = 1
Set ai2 = New RegArea
'查询结果（结点实体）存入目的工作区
'outflg =0为查询所有与区域相交的图元
lRes = objQuery.RegAskToArea(ai1, gisLIN_ENTITY, ai2, outflg)

'查询结果(线实体)存入列表对象(IDList)里
'outflg =1为查询所有与区域外的图元
Set objIDList = objQuery.RegAskToList(ai1, gisLIN_ENTITY, 1)
'......对objIDList的操作

Set ai1 = Nothing
Set ai2 = Nothing
Set RegAi = Nothing
Set objIDList = Nothing
End Sub

Private Sub RegInterRegPos_Click()
'判断两个区是否相交
Dim RegAi0 As RegArea
Dim RegAi1 As RegArea
Dim rxy0 As D_DotSet
Dim rxy1 As D_DotSet
Dim ne0 As LONGList
Dim ne1 As LONGList
Dim rdat0 As LONGList
Dim rdat1 As LONGList
Dim inf As Reg_Info
Dim count As Long

Set RegAi0 = New RegArea
If RegAi0.Load Then
'使用Query对象之前一定要先设置源工作区属性
objQuery.sourceArea = RegAi0
Else
Set RegAi0 = Nothing
Exit Sub
End If

Set RegAi1 = New RegArea
If Not RegAi1.Load Then
Set RegAi0 = Nothing
Set RegAi1 = Nothing
Exit Sub
End If

'判断两个区是否相交(方法一)
For count = 0 To RegAi1.count - 1
'下面判断和RegAi0中区1相交的RegAi1的区号
nRes = objQuery.RegInterReg(0, RegAi1, count)
If nRes Then
    MsgBox "和区" & count & "相交"
End If
Next count

'判断两个区是否相交(方法二)
'取RegAi0中的区1
If RegAi0.Get(1, rdat0, inf) Then
nRes = RegAi0.GetEdge(rdat0, rxy0, ne0)
End If

Set inf = Nothing
'下面判断和RegAi0中区1相交的RegAi1的区号
For count = 1 To RegAi1.count - 1
If RegAi1.Get(count, rdat1, inf) Then
    nRes = RegAi1.GetEdge(rdat1, rxy1, ne1)
End If
nRes = objQuery.RegInterReg1(rxy0, ne0, rxy1, ne1)

If nRes Then
    MsgBox "和区" & count & "相交!"
End If
Set inf = Nothing
Next count

Set ne0 = Nothing
Set ne1 = Nothing
Set rxy0 = Nothing
Set rxy1 = Nothing
Set rdat0 = Nothing
Set rdat1 = Nothing
Set RegAi0 = Nothing
Set RegAi1 = Nothing
End Sub

Private Sub SeekReg_Click()
Dim RegAi As New RegArea
Dim xy As D_Dot
Dim LayerPad As New LayerOnOffPad
If RegAi.Load Then
'使用Query对象之前一定要先设置源工作区属性
objQuery.sourceArea = RegAi
Else: Exit Sub
End If

Set xy = New D_Dot
xy.x = 10
xy.y = 10

lRes = objQuery.SeekReg(xy)

If lRes = 0 Then
MsgBox "点不在任何区内"
Else
MsgBox "点在区;" & lRes & "内！"
End If

'若打开层开关，则如下：（lRes返回查找到的区号）
'可以选择打开哪些层，这里假设要打开所有层
LayerPad.SetAllOff
lRes = objQuery.SeekReg(xy, LayerPad)

Set RegAi = Nothing
Set xy = Nothing
Set LayerPad = Nothing
End Sub

Private Sub SqlQuery_Click()
'不妨以区工作区为例
Dim ai As New RegArea
Dim ai1 As New RegArea
Dim objIDList As IDList
Dim regnum As Long

If ai.Load Then
'使用Query对象之前一定要先设置源工作区属性
objQuery.sourceArea = ai
Else: Exit Sub
End If

'说明：expIsSQLWhereClause-exp是否是SQL查询语言的WHERE子句,若=1则exp
'是WHERE子句,此时ai0必须是数据库工作区;dbAttAskToArea0(ai0,type,exp,ai1,0)
'与AttAskToArea0(ai0,type,exp,ai1)完全等价

'检索结果放入ai1工作区
lRes = objQuery.dbAttAskToArea0(gisREG_ENTITY, "ID>10", ai1, 0)
'与下面方法等价
'lRes = objQuery.AttAskToArea0(gisREG_ENTITY, "ID>100", ai1)
'若如下为expIsSQLWhereClause=1，则必须是数据库工作区
'lRes = objQuery.dbAttAskToArea0(gisREG_ENTITY, "ID>100", ai1, 1)
ai1.SaveAs
MsgBox lRes

'检索结果放入列表对象
'注意：因为使用了1，所以这里必须是数据库工作区
Set objIDList = objQuery.dbAttAskToList0(gisREG_ENTITY, "ID>10", 1)
'下面取列表中的区实体号
For regnum = 0 To objIDList.count - 1
MsgBox objIDList(regnum)
Next regnum

Set ai = Nothing
Set ai1 = Nothing
Set objIDList = Nothing
End Sub