Question

我想要一个过程来获取两个点并在它们之间建立一条路线，并且能够按州计算里程数。在Access VBA或VB.net中可以进行这样的过程吗？

到目前为止，我能够制定一条路线并获得距离，但我不确定接下来会发现每个州的行进状态和里程数。

这是我到目前为止所做的：

Public Sub route()


  Dim objApp As New MapPoint.Application
  Dim objMap As MapPoint.Map
  Dim objRoute As MapPoint.route


  'Set up application
  Set objMap = objApp.ActiveMap
  Set objRoute = objMap.ActiveRoute
  objApp.Visible = True
  objApp.UserControl = True


  'Add route stops and calculate the route
  objRoute.Waypoints.Add objMap.FindResults("Iron Mountain, MI").Item(1)
  objRoute.Waypoints.Add objMap.FindResults("Chicago, IL").Item(1)
  objRoute.Calculate

    For Each Item In objRoute.Directions
        MsgBox Item.Instruction & " " & Item.ElapsedDistance
    Next

End Sub

我仍然遇到的问题是我尝试使用Item.Location.StreetAddress.Region，但我得到：“对象变量或未设置块变量。”谁能告诉我如何找到特定方向点的状态？如果是这样，我相信我可以通过添加经过的英里数来找到经过的里程数 - 之前经过的英里数到它所属的州。

谢谢！

Answer 1

您看到的实际错误是由于滥用了FindResults集合。你盲目地假设元素1已经设置好了。情况不一定如此，您应首先检查ResultsQuality属性。这是一个非常常见的问题，经常出现在各种在线论坛上 - 这很常见，我在这里写了一篇关于它的快速文章：

http://www.mapping-tools.com/howto/programming/using-the-findresults-collection/

对于City，State位置，您可能也会使用FindAddressResults做得更好。在大多数情况下，这会导致“模糊结果”，但您可以遍历结果并选择第一个城市（通常有两个结果：城市和州）。

以上是对问题第二部分的回答。以下是我对总体战略的回应。从评论来看，看起来OP已经解决了，但我保留在这里，以便评论有意义。

我认为你不能做你想做的事情，除非你在内部有一个形状定义列表并进行了多边形点测试（是的，很多编程）。

仅当从街道地址明确创建位置对象时（例如，导入时），才会设置位置的StreetAddress属性。

另请注意，您的方法可能会出现一些大错误，因为无法保证Direction靠近State边界。此外，方向位置对象不在路线上 - 它们仅供查看。是的，有时他们会在路段上撒谎，但无法保证。我们的想法是你可以缩放到位置，并获得该方向的理想地图视图（左转等）。

Answer 2

我认为它实际上在改变状态时会添加一个方向，所以它不应该是那么不准确吗？我知道为了会计目的计算里程+/-几块钱并没有多大的差别，而且它可能比依靠司机记住俯视并在穿越州线时正确记录里程数更准确。在任何情况下，您都可以添加休息站以强制将其他路线添加到路线中，这可能会使其更准确 - http://www.mp2kmag.com/update/mappoint.newsletter/2011-05-05/
埃里克
m：312-399-1586

Answer 3

我一直在修改以下Access VBA代码。它是问题中代码的扩展，但我使用了GetObject()，因此我可以附加到MapPoint的现有实例。这样我就可以在MapPoint中创建我的路径（并根据需要调整），然后[Alt-Tab]进入Access并运行代码。

代码并不完整，但它似乎涵盖了基础知识。作为测试，我计划了一条来自＆＃34; New York，NY＆＃34;到加利福尼亚州洛杉矶＆＃34;当我运行我的VBA代码时，以下内容出现在VBA编辑器的立即窗口中：

"Origin_State: New York",0
"Entering New Jersey",1.57828283309937
"Entering Pennsylvania",76.8766632080078
"Entering Ohio",387.730041503906
"Entering Indiana",624.323974609375
"Entering Illinois",776.259155273438
"Entering Iowa",939.418151855469
"Entering Nebraska",1245.23413085938
"Entering Colorado",1599.96252441406
"Entering Utah",2054.32885742188
"Entering Arizona",2418.78686523438
"Entering Nevada",2448.091796875
"Entering California",2572.029296875
"End_of_route",2798.63793945313

代码如下：

Option Compare Database
Option Explicit

Dim objApp As MapPoint.Application
Dim objMap As MapPoint.Map

Const DebugMode = True  '' controls how error messages are displayed

Public Sub RouteTest()
    Dim objRoute As MapPoint.Route
    Dim objDirection As MapPoint.Direction
    Dim StateOfOrigin As String

    On Error GoTo RouteTest_Error
    '' attach to existing instance of MapPoint
    Set objApp = GetObject(, "MapPoint.Application")
    On Error GoTo 0  '' for debugging
    Set objMap = objApp.ActiveMap
    Set objRoute = objMap.ActiveRoute

    If objRoute.Directions Is Nothing Then
        DisplayErrorMessage "No route.", vbExclamation
        Exit Sub
    End If

    StateOfOrigin = GetState(objRoute.Directions(1).Location)
    Debug.Print """Origin_State: " & StateOfOrigin & """,0"

    For Each objDirection In objRoute.Directions
        If objDirection.Instruction Like "Entering *" Then
            Debug.Print """" & Replace(objDirection.Instruction, """", """""", 1, -1, vbBinaryCompare) & """," & objDirection.ElapsedDistance
        End If
    Next
    Set objDirection = objRoute.Directions(objRoute.Directions.Count)
    Debug.Print """End_of_route""," & objDirection.ElapsedDistance
    Set objDirection = Nothing

    Set objRoute = Nothing
    Set objMap = Nothing
    Set objApp = Nothing
    Exit Sub

    RouteTest_Error:
    If Err.Number = 429 Then
        DisplayErrorMessage "Unable to attach to existing instance of MapPoint.", vbCritical
    Else
        Err.Raise Err.Number
    End If
End Sub

Public Function GetState(loc As MapPoint.Location) As String
    '' adapted from code at http://www.mp2kmag.com/articles.asp?ArticleID=47
    Dim objResults As MapPoint.FindResults
    Dim objTempLoc As MapPoint.Location
    Dim rgn As String
    rgn = ""
    loc.Goto
    objMap.Altitude = 1
    Set objResults = objMap.ObjectsFromPoint(objMap.LocationToX(loc), objMap.LocationToY(loc))
    If objResults.ResultsQuality = geoAllResultsValid Then
        For Each objTempLoc In objResults
            If objTempLoc.Type = geoShowByRegion1 Then
                rgn = objTempLoc.Name
                Exit For
            End If
        Next
        Set objTempLoc = Nothing
    End If
    Set objResults = Nothing
    GetState = rgn
End Function

Private Sub DisplayErrorMessage(ErrorMessage As String, MessageBoxStyle As Long)
    If DebugMode Then
        Debug.Print ErrorMessage
    Else
        MsgBox ErrorMessage, MessageBoxStyle
    End If
End Sub

MapPoint：州内旅行的距离

3 个答案: