Origin-destination cost matrix solver
frmODCostMatrixSolver.vb
' Copyright 2012 ESRI
' 
' All rights reserved under the copyright laws of the United States
' and applicable international laws, treaties, and conventions.
' 
' You may freely redistribute and use this sample code, with or
' without modification, provided you include the original copyright
' notice and use restrictions.
' 
' See the use restrictions.
' 

'*************************************************************************************
'       ArcGIS Network Analyst extension - OD Cost Matrix Demonstration

'   This simple code shows how to :
'    1) Open a workspace and open a Network DataSet
'    2) Create a NAContext and its NASolver
'    3) Load Origins/Destinations from Feature Classes and create Network Locations
'    4) Set the Solver parameters
'    5) Solve an OD Cost Matrix problem
'    6) Read the ODLines output to display the total number of routes found 
'       and the route details
'************************************************************************************

Imports System
Imports System.Windows.Forms
Imports ESRI.ArcGIS.Carto
Imports ESRI.ArcGIS.esriSystem
Imports ESRI.ArcGIS.Geodatabase
Imports ESRI.ArcGIS.Geometry
Imports ESRI.ArcGIS.NetworkAnalyst


Partial Public Class frmODCostMatrixSolver
  Inherits Form
  Private m_NAContext As INAContext

  Public Sub New()

    'This call is required by the Windows Form Designer.
    InitializeComponent()

    'Add any initialization after the InitializeComponent() call
    Initialize()
  End Sub
  ''' <summary>
    ''' Initialize the solver by calling the ArcGIS Network Analyst extension functions.
  ''' </summary>
  Private Sub Initialize()
    Dim featureWorkspace As IFeatureWorkspace = Nothing
    Dim networkDataset As INetworkDataset = Nothing

    ' Open Network Dataset
    Try
      Dim workspace As IWorkspace = OpenWorkspace(Application.StartupPath & "\..\..\..\..\..\Data\SanFrancisco\SanFrancisco.gdb")
      networkDataset = OpenNetworkDataset(workspace, "Transportation", "Streets_ND")
      featureWorkspace = TryCast(workspace, IFeatureWorkspace)
    Catch ex As Exception
      System.Windows.Forms.MessageBox.Show("Unable to open dataset. Error Message: " & ex.Message)
      Me.Close()
      Return
    End Try

    ' Create NAContext and NASolver
    m_NAContext = CreateSolverContext(networkDataset)

    ' Get available cost attributes from the network dataset
    Dim networkAttribute As INetworkAttribute
    For i As Integer = 0 To networkDataset.AttributeCount - 2
      networkAttribute = networkDataset.Attribute(i)
      If networkAttribute.UsageType = esriNetworkAttributeUsageType.esriNAUTCost Then
        comboCostAttribute.Items.Add(networkAttribute.Name)
      End If
    Next i
    comboCostAttribute.SelectedIndex = 0
    textTargetFacility.Text = ""
    textCutoff.Text = ""

    ' Load locations from feature class
    Dim inputFClass As IFeatureClass = featureWorkspace.OpenFeatureClass("Stores")
    LoadNANetworkLocations("Origins", inputFClass, 100)

    inputFClass = featureWorkspace.OpenFeatureClass("Hospitals")
    LoadNANetworkLocations("Destinations", inputFClass, 100)

    ' Create layer for network dataset and add to ArcMap
    Dim networkLayer As INetworkLayer = New NetworkLayerClass()
    networkLayer.NetworkDataset = networkDataset
    Dim layer As ILayer = TryCast(networkLayer, ILayer)
    layer.Name = "Network Dataset"
    axMapControl.AddLayer(layer, 0)

    ' Create a network analysis layer and add to ArcMap
    Dim naLayer As INALayer = m_NAContext.Solver.CreateLayer(m_NAContext)
    layer = TryCast(naLayer, ILayer)
    layer.Name = m_NAContext.Solver.DisplayName
    axMapControl.AddLayer(layer, 0)
  End Sub

  ''' <summary>
  ''' Call the OD cost matrix solver and display the results
  ''' </summary>
  ''' <param name="sender">Sender of the event</param>
  ''' <param name="e">Event</param>
  Private Sub cmdSolve_Click(ByVal sender As Object, ByVal e As EventArgs) Handles cmdSolve.Click
    Try
      listOutput.Items.Clear()
      cmdSolve.Text = "Solving..."

      SetSolverSettings()

      ' Solve
      Dim gpMessages As IGPMessages = New GPMessagesClass()
      If (Not m_NAContext.Solver.Solve(m_NAContext, gpMessages, Nothing)) Then
        ' Get the ODLines output
        GetODOutput()
      Else
        listOutput.Items.Add("Partial Result")
      End If

      ' Display Error/Warning/Informative Messages
      If gpMessages IsNot Nothing Then
        For i As Integer = 0 To gpMessages.Count - 1
          Select Case gpMessages.GetMessage(i).Type
            Case esriGPMessageType.esriGPMessageTypeError
              listOutput.Items.Add("Error " & gpMessages.GetMessage(i).ErrorCode.ToString() & " " & gpMessages.GetMessage(i).Description)
            Case esriGPMessageType.esriGPMessageTypeWarning
              listOutput.Items.Add("Warning " & gpMessages.GetMessage(i).Description)
            Case Else
              listOutput.Items.Add("Information " & gpMessages.GetMessage(i).Description)
          End Select
        Next i
      End If

      ' Zoom to the extent of the route
      Dim gDataset As IGeoDataset = TryCast(m_NAContext.NAClasses.ItemByName("ODLines"), IGeoDataset)
      Dim envelope As IEnvelope = gDataset.Extent
      If (Not envelope.IsEmpty) Then
        envelope.Expand(1.1, 1.1, True)
        axMapControl.Extent = envelope
      End If

      axMapControl.Refresh()
    Catch ex As Exception
      MessageBox.Show(ex.Message)
    Finally
      cmdSolve.Text = "Find OD Cost Matrix"
    End Try
  End Sub

  ''' <summary>
  ''' Get the Impedance Cost from the ODLines Class Output
  ''' </summary>
  Public Sub GetODOutput()
    Dim naTable As ITable = TryCast(m_NAContext.NAClasses.ItemByName("ODLines"), ITable)
    If naTable Is Nothing Then
      listOutput.Items.Add("Impossible to get the ODLines table")
    End If

    listOutput.Items.Add("Number of destinations found: " & naTable.RowCount(Nothing).ToString())
    listOutput.Items.Add("")

    If naTable.RowCount(Nothing) > 0 Then
      listOutput.Items.Add("OriginID, DestinationID, DestinationRank, Total_" & comboCostAttribute.Text)
      Dim total_impedance As Double
      Dim OriginID As Long
      Dim DestinationID As Long
      Dim DestinationRank As Long

      Dim naCursor As ICursor = naTable.Search(Nothing, False)
      Dim naRow As IRow = naCursor.NextRow()
      Do While naRow IsNot Nothing
        OriginID = Long.Parse(naRow.Value(naTable.FindField("OriginID")).ToString())
        DestinationID = Long.Parse(naRow.Value(naTable.FindField("DestinationID")).ToString())
        DestinationRank = Long.Parse(naRow.Value(naTable.FindField("DestinationRank")).ToString())
        total_impedance = Double.Parse(naRow.Value(naTable.FindField("Total_" & comboCostAttribute.Text)).ToString())
        listOutput.Items.Add(OriginID.ToString() & ", " & DestinationID.ToString() & ", " & DestinationRank.ToString() & ", " & total_impedance.ToString("#0.00"))

        naRow = naCursor.NextRow()
      Loop
    End If

    listOutput.Refresh()
  End Sub

#Region "Network Analyst functions"

  ''' <summary>
  ''' Create NASolver and NAContext
  ''' </summary>
  ''' <param name="networkDataset">Input network dataset</param>
  ''' <returns>NAContext</returns>
  Public Function CreateSolverContext(ByVal networkDataset As INetworkDataset) As INAContext
    'Get the Data Element
    Dim deNDS As IDENetworkDataset = GetDENetworkDataset(networkDataset)
    Dim naSolver As INASolver = New NAODCostMatrixSolver()
    Dim contextEdit As INAContextEdit = TryCast(naSolver.CreateContext(deNDS, naSolver.Name), INAContextEdit)
    'Bind a context using the network Dataset 
    contextEdit.Bind(networkDataset, New GPMessagesClass())

    Return TryCast(contextEdit, INAContext)
  End Function

  ''' <summary>
  ''' Set Solver Settings
  ''' </summary>
  ''' <param name="strNAClassName">NAClass name</param>
  ''' <param name="inputFC">Input feature class</param>
  ''' <param name="snapTolerance">Snap tolerance</param>
  Public Sub LoadNANetworkLocations(ByVal strNAClassName As String, ByVal inputFC As IFeatureClass, ByVal snapTolerance As Double)
    Dim classes As INamedSet = m_NAContext.NAClasses
    Dim naClass As INAClass = TryCast(classes.ItemByName(strNAClassName), INAClass)

    ' Delete existing locations from the specified NAClass
    naClass.DeleteAllRows()

    ' Create a NAClassLoader and set the snap tolerance (meters unit)
    Dim loader As INAClassLoader = New NAClassLoader()
    loader.Locator = m_NAContext.Locator
    If snapTolerance > 0 Then
      loader.Locator.SnapTolerance = snapTolerance
    End If
    loader.NAClass = naClass

    ' Create field map to automatically map fields from input class to NAclass
    Dim fieldMap As INAClassFieldMap = New NAClassFieldMapClass()
    fieldMap.CreateMapping(naClass.ClassDefinition, inputFC.Fields)
    loader.FieldMap = fieldMap

    ' Avoid loading network locations onto non-traversable portions of elements
    Dim locator As INALocator3 = TryCast(m_NAContext.Locator, INALocator3)
    locator.ExcludeRestrictedElements = True
    locator.CacheRestrictedElements(m_NAContext)

    ' Load network locations
    Dim rowsIn As Integer = 0
    Dim rowsLocated As Integer = 0
    loader.Load(CType(inputFC.Search(Nothing, True), ICursor), Nothing, rowsIn, rowsLocated)

    ' Message all of the network analysis agents that the analysis context has changed.
    Dim naContextEdit As INAContextEdit = TryCast(m_NAContext, INAContextEdit)
    naContextEdit.ContextChanged()
  End Sub

  ''' <summary>
  ''' Set Solver Settings
  ''' </summary>
  Public Sub SetSolverSettings()
    ' Set OD Solver specific settings
    Dim solver As INASolver = m_NAContext.Solver
    Dim odSolver As INAODCostMatrixSolver = TryCast(solver, INAODCostMatrixSolver)
    If textCutoff.Text.Length > 0 AndAlso IsNumeric(textCutoff.Text.Trim()) Then
      odSolver.DefaultCutoff = textCutoff.Text
    Else
      odSolver.DefaultCutoff = Nothing
    End If

    If textTargetFacility.Text.Length > 0 AndAlso IsNumeric(textTargetFacility.Text.Trim()) Then
      odSolver.DefaultTargetDestinationCount = textTargetFacility.Text
    Else
      odSolver.DefaultTargetDestinationCount = Nothing
    End If

    odSolver.OutputLines = esriNAOutputLineType.esriNAOutputLineStraight

    ' Set generic solver settings
    ' Set the impedance attribute
    Dim solverSettings As INASolverSettings = TryCast(solver, INASolverSettings)
    solverSettings.ImpedanceAttributeName = comboCostAttribute.Text

    ' Set the OneWay restriction if necessary
    Dim restrictions As IStringArray = solverSettings.RestrictionAttributeNames
    restrictions.RemoveAll()
    If checkUseRestriction.Checked Then
      restrictions.Add("oneway")
    End If
    solverSettings.RestrictionAttributeNames = restrictions

    ' Restrict UTurns
    solverSettings.RestrictUTurns = esriNetworkForwardStarBacktrack.esriNFSBNoBacktrack
    solverSettings.IgnoreInvalidLocations = True

    ' Set the hierarchy attribute
    solverSettings.UseHierarchy = checkUseHierarchy.Checked
    If solverSettings.UseHierarchy Then
      solverSettings.HierarchyAttributeName = "hierarchy"
    End If

    ' Do not forget to update the context after you set your impedance
    solver.UpdateContext(m_NAContext, GetDENetworkDataset(m_NAContext.NetworkDataset), New GPMessagesClass())
  End Sub

  ''' <summary>
  ''' Geodatabase function: open work space
  ''' </summary>
  ''' <param name="strGDBName">Input file name</param>
  ''' <returns>Workspace</returns>
  Public Function OpenWorkspace(ByVal strGDBName As String) As IWorkspace
    ' As Workspace Factories are Singleton objects, they must be instantiated with the Activator
    Dim workspaceFactory As IWorkspaceFactory = TryCast(Activator.CreateInstance(Type.GetTypeFromProgID("esriDataSourcesGDB.FileGDBWorkspaceFactory")), IWorkspaceFactory)
    Return workspaceFactory.OpenFromFile(strGDBName, 0)
  End Function

  ''' <summary>
  ''' Geodatabase function: open network Dataset
  ''' </summary>
  ''' <param name="workspace">Input workspace</param>
  ''' <param name="strNDSName">Input network dataset name</param>
  ''' <returns></returns>
  Public Function OpenNetworkDataset(ByVal workspace As IWorkspace, ByVal featureDatasetName As String, ByVal strNDSName As String) As INetworkDataset
    ' Obtain the dataset container from the workspace
    Dim featureWorkspace As IFeatureWorkspace = TryCast(workspace, IFeatureWorkspace)
    Dim featureDataset As IFeatureDataset = featureWorkspace.OpenFeatureDataset(featureDatasetName)
    Dim featureDatasetExtensionContainer As IFeatureDatasetExtensionContainer = TryCast(featureDataset, IFeatureDatasetExtensionContainer)
    Dim featureDatasetExtension As IFeatureDatasetExtension = featureDatasetExtensionContainer.FindExtension(ESRI.ArcGIS.Geodatabase.esriDatasetType.esriDTNetworkDataset)
    Dim datasetContainer3 As IDatasetContainer3 = TryCast(featureDatasetExtension, IDatasetContainer3)

    ' Use the container to open the network dataset
    Dim dataset As Object = datasetContainer3.DatasetByName(ESRI.ArcGIS.Geodatabase.esriDatasetType.esriDTNetworkDataset, strNDSName)
    Return TryCast(dataset, INetworkDataset)
  End Function

  ''' <summary>
  ''' Geodatabase function: get network Dataset
  ''' </summary>
  ''' <param name="networkDataset">Input network dataset</param>
  ''' <returns>DE network dataset</returns>
  Public Function GetDENetworkDataset(ByVal networkDataset As INetworkDataset) As IDENetworkDataset
    ' Cast from the Network Dataset to the DatasetComponent
    Dim dsComponent As IDatasetComponent = TryCast(networkDataset, IDatasetComponent)

    ' Get the data element
    Return TryCast(dsComponent.DataElement, IDENetworkDataset)
  End Function
#End Region

  ''' <summary>
  ''' Check whether a string represents a double value.
  ''' </summary>
  ''' <param name="str"></param>
  ''' <returns></returns>
  Private Function IsNumeric(ByVal str As String) As Boolean
    Try
      Double.Parse(str.Trim())
    Catch e1 As Exception
      Return False
    End Try

    Return True
  End Function
End Class