module1.bas

利用MAPX和VB编的一个关于地图匹配的程序。加载地图后方可使用！

Attribute VB_Name = "Module1"
Type Car
 X As Double
 Y As Double
 qian As Integer
 hou As Integer
End Type

 Type SearchLine
   Firstpointx As Double
   FirstPointY As Double
   SecondPointX As Double
   SecondPointY As Double
   ThirdPointX As Double
   ThirdPointY As Double
   D As Double
   Angle As Double
   Name As String
End Type

Public Function MapMatch(ByVal GpsX As Double, ByVal GpsY As Double) As Car  '地图匹配子程序
Dim Road() As SearchLine
Static LastGpsX As Double
Static LastGpsY As Double
Static LCarGpsX As Double
Static LCarGpsY As Double

Dim r As Double
Dim m1 As Double
Dim m2 As Double
Dim agl As Double
Dim disagl As Double
Dim N As Integer
Dim i As Integer
Dim j As Integer
Dim k1 As Integer
Dim k2 As Integer

Dim f_point, s_point As Integer
Dim big As Double
Dim small As Double
Dim Max As Double
Dim Sel_Features As mapxlib.Features
Dim Sel_Feature As mapxlib.Feature
Dim Sel_Point As mapxlib.FindFeature


Debug.Print GpsX, GpsY, LastGpsX, LastGpsY, "CAR", LCarGpsX, LCarGpsY
big = 1E+20
small = 0.005
r = 0.05
Dim pt As New Point
pt.Set GpsX, GpsY
'选取待匹配路段
 Set Sel_Features = Form1.Map1.Layers("TC-B路段").SearchWithinDistance(pt, r, miUnitKilometer, 1)
N = Sel_Features.Count
Debug.Print N & "NNN"

'搜索目标路段

If N = 0 Then
  MapMatch.X = LCarGpsX
  MapMatch.Y = LCarGpsY

ElseIf N > 0 Then
  ReDim Road(N) As SearchLine
   i = 1
   j = 9999
   Max = 9999
   k2 = 9999
  For Each Sel_Feature In Sel_Features

'选取路段节点，分直线段和非直线段两种
'目标路段的起终点
     Road(i).Name = Sel_Feature.Name
       If CStr(Mid(Road(i).Name, 2, 1)) = "-" Then
       f_point = CInt(Mid(Road(i).Name, 1, 1))
       s_point = CInt(Mid(Road(i).Name, 3))
       ElseIf CStr(Mid(Road(i).Name, 3, 1)) = "-" Then
       f_point = CInt(Mid(Road(i).Name, 1, 2))
       s_point = CInt(Mid(Road(i).Name, 4))
       ElseIf CStr(Mid(Road(i).Name, 4, 1)) = "-" Then
       f_point = CInt(Mid(Road(i).Name, 1, 3))
       s_point = CInt(Mid(Road(i).Name, 5))
       ElseIf CStr(Mid(Road(i).Name, 5, 1)) = "-" Then
       f_point = CInt(Mid(Road(i).Name, 1, 4))
       s_point = CInt(Mid(Road(i).Name, 6))
       ElseIf CStr(Mid(Road(i).Name, 6, 1)) = "-" Then
       f_point = CInt(Mid(Road(i).Name, 1, 5))
       s_point = CInt(Mid(Road(i).Name, 7))
       End If

     Dim ft_fin As mapxlib.FindFeature
     Set ft_fin = Form1.Map1.Layers("TC-B路段").Find.Search(CStr(f_point) & "-" & CStr(s_point))


Debug.Print ft_fin.Parts.Item(1).Count & "count"
'直线段节点选取
    If ft_fin.Parts.Item(1).Count = 2 Then
       Set Sel_Point = Form1.Map1.Layers("TC-B节点").Find.Search(f_point)
           Road(i).Firstpointx = Sel_Point.CenterX
           Road(i).FirstPointY = Sel_Point.CenterY
       Set Sel_Point = Form1.Map1.Layers("TC-B节点").Find.Search(s_point)
           Road(i).SecondPointX = Sel_Point.CenterX
           Road(i).SecondPointY = Sel_Point.CenterY
       If Road(i).Firstpointx = Road(i).SecondPointX Then
       Road(i).ThirdPointX = Road(i).Firstpointx
       Road(i).ThirdPointY = GpsY
       Road(i).Angle = 90
       ElseIf Road(i).FirstPointY = Road(i).SecondPointY Then
       Road(i).ThirdPointX = GpsX
       Road(i).ThirdPointY = Road(i).FirstPointY
       Road(i).Angle = 0
       ElseIf Road(i).Firstpointx < Road(i).SecondPointX Or Road(i).FirstPointY < Road(i).SecondPointY Then
       m1 = (Road(i).SecondPointY - Road(i).FirstPointY) / (Road(i).SecondPointX - Road(i).Firstpointx)
       m2 = -1 / m1
       Road(i).ThirdPointX = (GpsY - Road(i).SecondPointY - m2 * GpsX + m1 * Road(i).SecondPointX) / (m1 - m2)
       Road(i).ThirdPointY = m1 * (Road(i).ThirdPointX - Road(i).SecondPointX) + Road(i).SecondPointY
       Road(i).Angle = Atn((Road(i).SecondPointY - Road(i).FirstPointY) / (Road(i).SecondPointX - Road(i).Firstpointx)) * 180 / 3.14159265358979
       ElseIf Road(i).Firstpointx > Road(i).SecondPointX Or Road(i).FirstPointY > Road(i).SecondPointY Then
       m1 = (Road(i).SecondPointY - Road(i).FirstPointY) / (Road(i).SecondPointX - Road(i).Firstpointx)
       m2 = -1 / m1
       Road(i).ThirdPointX = (GpsY - Road(i).FirstPointY - m2 * GpsX + m1 * Road(i).Firstpointx) / (m1 - m2)
       Road(i).ThirdPointY = m1 * (Road(i).ThirdPointX - Road(i).Firstpointx) + Road(i).FirstPointY
       Road(i).Angle = Atn((Road(i).SecondPointY - Road(i).FirstPointY) / (Road(i).SecondPointX - Road(i).Firstpointx)) * 180 / 3.14159265358979
       End If
        Debug.Print (Form1.Map1.Distance(Road(i).ThirdPointX, Road(i).ThirdPointY, Road(i).Firstpointx, Road(i).FirstPointY) + Form1.Map1.Distance(Road(i).ThirdPointX, Road(i).ThirdPointY, Road(i).SecondPointX, Road(i).SecondPointY)) - Form1.Map1.Distance(Road(i).Firstpointx, Road(i).FirstPointY, Road(i).SecondPointX, Road(i).SecondPointY)
       If (Form1.Map1.Distance(Road(i).ThirdPointX, Road(i).ThirdPointY, Road(i).Firstpointx, Road(i).FirstPointY) + Form1.Map1.Distance(Road(i).ThirdPointX, Road(i).ThirdPointY, Road(i).SecondPointX, Road(i).SecondPointY)) - Form1.Map1.Distance(Road(i).Firstpointx, Road(i).FirstPointY, Road(i).SecondPointX, Road(i).SecondPointY) < small Then
         Road(i).D = Sqr((GpsX - Road(i).ThirdPointX) ^ 2 + (GpsY - Road(i).ThirdPointY) ^ 2)
       Else
         Road(i).D = 9998
       End If
       Debug.Print Road(i).ThirdPointX, Road(i).ThirdPointY, Road(i).D
       If N <> 1 Then
        If Road(i).D <> 9998 Then
          If LastGpsX <> 0 And LastGpsY <> 0 Then
            If GpsY = LastGpsY And GpsX <> LastGpsX Then
            agl = 0
            ElseIf GpsX = LastGpsX And GpsY > LastGpsY Then
            agl = 90
            ElseIf GpsX = LastGpsX And GpsY < LastGpsY Then
            agl = -90
            Else
            agl = Atn((GpsY - LastGpsY) / (GpsX - LastGpsX)) * 180 / 3.14159265358979
            End If
            If Road(i).Angle * agl < 0 Then
            disagl = Abs(Abs(Road(i).Angle) - Abs(agl))
            Else
            disagl = Abs(Road(i).Angle - agl)
            End If
            If disagl > 25 Then
            Road(i).D = 9998
            End If
          End If
        End If
       End If
       Debug.Print Road(i).SecondPointX, Road(i).SecondPointY, Road(i).Firstpointx, Road(i).FirstPointY
       Debug.Print i, "i", Road(i).Angle, "angle", agl, "agl", disagl, "hahaha"
'非直线段节点选取
    ElseIf ft_fin.Parts.Item(1).Count > 2 Then
     For k1 = 1 To ft_fin.Parts.Item(1).Count - 1
       fpointx = ft_fin.Parts.Item(1).Item(k1).X
       fpointy = ft_fin.Parts.Item(1).Item(k1).Y
       spointx = ft_fin.Parts.Item(1).Item(k1 + 1).X
       spointy = ft_fin.Parts.Item(1).Item(k1 + 1).Y
 Debug.Print fpointx, fpointy, spointx, spointy
       If fpointx = spointx And fpointy <> spointy Then
       TpointX = fpointx
       TpointY = GpsY
       ElseIf fpointy = spointy And fpointx <> spointx Then
       TpointX = GpsX
       TpointY = fpointy
       ElseIf fpointx = spointx And fpointy = spointy Then
       TpointX = fpointx
       TpointY = fpointy
       ElseIf fpointx < spointx Or fpointy < spointy Then
       m1 = (spointy - fpointy) / (spointx - fpointx)
       m2 = -1 / m1
       TpointX = (GpsY - spointy - m2 * GpsX + m1 * spointx) / (m1 - m2)
       TpointY = m1 * (TpointX - spointx) + spointy
       ElseIf fpointx > spointx Or fpointy > spointy Then
       m1 = (spointy - fpointy) / (spointx - fpointx)
       m2 = -1 / m1
       TpointX = (GpsY - fpointy - m2 * GpsX + m1 * fpointx) / (m1 - m2)
       TpointY = m1 * (TpointX - fpointx) + fpointy
       End If
 Debug.Print TpointX, TpointY
    Debug.Print ((Form1.Map1.Distance(TpointX, TpointY, fpointx, fpointy) + Form1.Map1.Distance(TpointX, TpointY, spointx, spointy)) - Form1.Map1.Distance(fpointx, fpointy, spointx, spointy))
         If (Form1.Map1.Distance(TpointX, TpointY, fpointx, fpointy) + Form1.Map1.Distance(TpointX, TpointY, spointx, spointy)) - Form1.Map1.Distance(fpointx, fpointy, spointx, spointy) < small Then
           If fpointx = spointx And fpointy = spointy Then
             Road(i).D = 9998
           Else
             Road(i).ThirdPointX = TpointX
             Road(i).ThirdPointY = TpointY
             If spointx = fpointx Then
             Road(i).Angle = 90
             ElseIf spointy = fpointy Then
             Road(i).Angle = 0
             Else
             Road(i).Angle = Atn((spointy - fpointy) / (spointx - fpointx)) * 180 / 3.14159265358979
             End If
             Road(i).D = Sqr((GpsX - Road(i).ThirdPointX) ^ 2 + (GpsY - Road(i).ThirdPointY) ^ 2)
           End If
         Else: Road(i).D = 9998
         End If
    Debug.Print i, Road(i).D, k1, Road(i).ThirdPointX, Road(i).ThirdPointY & "1111111111111111"
      If N <> 1 Then
      If Road(i).D <> 9998 Then
          If LastGpsX <> 0 And LastGpsY <> 0 Then
            If GpsY = LastGpsY And GpsX <> LastGpsX Then
            agl = 0
            ElseIf GpsX = LastGpsX And GpsY > LastGpsY Then
            agl = 90
            ElseIf GpsX = LastGpsX And GpsY < LastGpsY Then
            agl = -90
            Else
            agl = Atn((GpsY - LastGpsY) / (GpsX - LastGpsX)) * 180 / 3.14159265358979
            End If
            If Road(i).Angle * agl < 0 Then
            disagl = Abs(Abs(Road(i).Angle) - Abs(agl))
            Else
            disagl = Abs(Road(i).Angle - agl)
            End If
            If disagl > 25 Then
            Road(i).D = 9998
            End If
          End If
       End If
       End If
  Debug.Print i, "i", Road(i).Angle, "angle", agl, "agl", disagl, "hahaha"
     If Road(i).D < Max Then
       Max = Road(i).D
      Else: Max = Max
      End If
      Road(i).D = Max
      Next
     End If
  Debug.Print Max, "max", Road(i).D, "ddddddddd", i, "iiiiiiii", Road(i).Angle, "road(i).angle"

 
   '确定匹配路段
     If Road(i).D < big Then
        big = Road(i).D
        j = i
     End If
   i = i + 1
  Next
Debug.Print j, "wjwjwjwjwjwjwj"
Debug.Print Road(j).Name
 If Road(j).ThirdPointX <> 0 And Road(j).ThirdPointY <> 0 Then
  MapMatch.X = Road(j).ThirdPointX
  MapMatch.Y = Road(j).ThirdPointY
 Else
 MapMatch.X = LCarGpsX
  MapMatch.Y = LCarGpsY
 End If
Debug.Print big, j, MapMatch.X, MapMatch.Y, Road(j).D, "car", LCarGpsX, LCarGpsY


End If

'判断车辆行驶的前后节点************************************
Dim finfeat As Features
Dim CarPt As New Point
CarPt.Set MapMatch.X, MapMatch.Y
Set finfeat = Form1.Map1.Layers.Item("TC-B路段").SearchAtPoint(CarPt)
Dim Q As Integer
Dim H As Integer
Dim W As Integer
Dim CarNm As String
CarNm = finfeat.Item(1).Name
W = InStr(1, CarNm, "-", vbTextCompare)
Q = CInt(Mid(CarNm, 1, W - 1))
H = CInt(Mid(CarNm, W + 1))

Debug.Print CarNm, Q, H

Dim FindPointQ As FindFeature
Dim FindPointH As FindFeature
Set FindPointQ = Form1.Map1.Layers.Item("TC-B节点").Find.Search(Q)
Set FindPointH = Form1.Map1.Layers.Item("TC-B节点").Find.Search(H)

Debug.Print GpsX, LastGpsX
If LastGpsX = 0 Or LastGpsY = 0 Then
  LastGpsX = GpsX
  LastGpsY = GpsY
  LCarGpsX = MapMatch.X
  LCarGpsY = MapMatch.Y
Else

If GpsX > LastGpsX Then
   If FindPointQ.CenterX > FindPointH.CenterX Then
      MapMatch.qian = Q
      MapMatch.hou = H
   Else
      MapMatch.qian = H
      MapMatch.hou = Q
   End If
 ElseIf GpsX < LastGpsX Then
   If FindPointQ.CenterX < FindPointH.CenterX Then
      MapMatch.qian = Q
      MapMatch.hou = H
   Else
      MapMatch.qian = H
      MapMatch.hou = Q
   End If
 Else
   If GpsY > LastGpsY Then
      If FindPointQ.CenterY > FindPointH.CenterY Then
         MapMatch.qian = Q
         MapMatch.hou = H
      Else
         MapMatch.qian = H
         MapMatch.hou = Q
      End If
   ElseIf GpsY < LastGpsY Then
      If FindPointQ.CenterY < FindPointH.CenterY Then
         MapMatch.qian = Q
         MapMatch.hou = H
      Else
         MapMatch.qian = H
         MapMatch.hou = Q
      End If
   Else
         MapMatch.qian = MapMatch.qian
         MapMatch.hou = MapMatch.hou
   End If
 End If
 Debug.Print MapMatch.qian, MapMatch.hou
   
  LastGpsX = GpsX
  LastGpsY = GpsY
  LCarGpsX = MapMatch.X
  LCarGpsY = MapMatch.Y
 End If
 '******************************************************
End Function