ArcGIS_Routing_VBNet\App_Code\NetworkAnalystUtility.vb
' Copyright 2010 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. ' Imports Microsoft.VisualBasic Imports System Imports ESRI.ArcGIS.Server Imports ESRI.ArcGIS.esriSystem Imports ESRI.ArcGIS.Geometry Imports ESRI.ArcGIS.Carto Imports ESRI.ArcGIS.Geodatabase Imports ESRI.ArcGIS.NetworkAnalyst Imports System.Collections Imports System.Data Imports System.Collections.Specialized Imports ESRI.ArcGIS.ADF.Web.DataSources.ArcGISServer Imports ESRI.ArcGIS.ADF.Web.Geometry Namespace ESRI.ArcGIS.Server.Web.NetworkAnalyst ''' <summary> ''' Utility class for working with Network analyst ''' </summary> Public Class NetworkAnalystUtility ''' <summary> ''' Constructor ''' </summary> Public Sub New() End Sub ''' <summary> ''' Add network location ''' </summary> ''' <param name="naContext">Layer to add to</param> ''' <param name="locationClassName">Type of location to add</param> ''' <param name="point">Geometry of location</param> ''' <param name="locationName">Name of location</param> ''' <param name="tolerance">Tolerance to use</param> ''' <returns>Whether the location was added</returns> Public Shared Function AddLocation(ByVal naContext As INAContext, ByVal locationClassName As String, ByVal point As IPoint, ByVal locationName As String, ByVal tolerance As Double) As Boolean ' Get NAClass Dim naClass As INAClass = TryCast(naContext.NAClasses.ItemByName(locationClassName), INAClass) Dim featureClass As IFeatureClass = TryCast(naClass, IFeatureClass) Dim fields As IFields = featureClass.Fields ' Find the network location using the locator Dim naLocator As INALocator = naContext.Locator naLocator.SnapTolerance = tolerance Dim naLocation As INALocation = Nothing Dim outPoint As IPoint = Nothing Dim distanceFromPoint As Double = 0 naLocator.QueryLocationByPoint(point, naLocation, outPoint, distanceFromPoint) ' Get total count of features in class (needed for Sequence) Dim count As Integer = featureClass.FeatureCount(Nothing) ' Create feature and set shape Dim feature As IFeature = featureClass.CreateFeature() CType(feature, IRowSubtypes).InitDefaultValues() feature.Shape = point ' Set field values for NALocation, Name, Sequence, Status ' Set NALocation CType(feature, INALocationObject).NALocation = naLocation ' Set name field If locationName.Trim().Length > 0 Then feature.Value(fields.FindField("Name")) = locationName End If ' If Stops, set Sequence field (required to go from 1 to N) Dim sequenceFieldIndex As Integer = fields.FindField("Sequence") If sequenceFieldIndex >= 0 Then feature.Value(sequenceFieldIndex) = count + 1 End If ' Set status if not located If naLocation.IsLocated = False Then feature.Value(fields.FindField("Status")) = esriNAObjectStatus.esriNAObjectStatusNotLocated End If ' Make sure to store the feature feature.Store() Return naLocation.IsLocated End Function ''' <summary> ''' Get directions ''' </summary> ''' <param name="naContext">The network analyst layer</param> ''' <param name="locationClassName">The output class name, e.g. Routes</param> ''' <param name="serverContext">The server context</param> ''' <returns>Route results</returns> Public Shared Function GetDirections(ByVal naContext As INAContext, ByVal locationClassName As String, ByVal serverContext As IServerContext) As NetworkAnalystRouteResult ' Check if we have results Dim result As INATraversalResultQuery = TryCast(naContext.Result, INATraversalResultQuery) If result Is Nothing Then Return Nothing End If Dim resultCount As Integer = result.FeatureClass(esriNetworkElementType.esriNETEdge).FeatureCount(Nothing) If resultCount = 0 Then Return Nothing End If Dim naClass As INAClass = TryCast(naContext.NAClasses.ItemByName(locationClassName), INAClass) ' Get Result Features Dim fClass As IFeatureClass = TryCast(naClass, IFeatureClass) Dim resultSet As ESRI.ArcGIS.esriSystem.ISet Dim filter As IQueryFilter If Not serverContext Is Nothing Then resultSet = TryCast(serverContext.CreateObject("esriSystem.Set"), ISet) filter = TryCast(serverContext.CreateObject("esriGeodatabase.QueryFilter"), IQueryFilter) Else resultSet = New ESRI.ArcGIS.esriSystem.SetClass() filter = New QueryFilterClass() End If Dim cursor As ICursor = TryCast(fClass.Search(Nothing, False), ICursor) Dim row As IRow = cursor.NextRow() Do While Not row Is Nothing resultSet.Add(row) row = cursor.NextRow() Loop ' Prepare Directions Dim namedSet As INamedSet = naContext.Agents Dim agentName As String = namedSet.Name(0) Dim agent As INAStreetDirectionsAgent = TryCast(namedSet.ItemByName(agentName), INAStreetDirectionsAgent) Dim track As ITrackCancel If Not serverContext Is Nothing Then track = TryCast(serverContext.CreateObject("esriDisplay.CancelTracker"), ITrackCancel) Else track = New ESRI.ArcGIS.Display.CancelTrackerClass() End If Dim naAgent As INAAgent = TryCast(agent, INAAgent) naAgent.OnResultUpdated() agent.Execute(resultSet, track) ' Get Directions Dim nasResultItems As ArrayList = New ArrayList() Dim container As INAStreetDirectionsContainer = agent.DirectionsContainer Dim count As Integer = 0 Dim columnName, columnValue As String Dim dataRow As DataRow Dim envelope As IEnvelope Dim i As Integer = 0 Do While i < container.DirectionsCount Dim resultItem As NetworkAnalystRouteResult = New NetworkAnalystRouteResult() Dim streetDirections As INAStreetDirections = container.Directions(i) Dim streetDirection As INAStreetDirection = streetDirections.Summary Dim stringType As esriDirectionsStringType = esriDirectionsStringType.esriDSTGeneral ' Get Summary Dim summary As StringDictionary = New StringDictionary() summary("Route") = streetDirections.RouteName count = streetDirection.StringCount Dim k As Integer = 0 Do While k < count stringType = streetDirection.StringType(k) columnName = GetDirectionsStringType(stringType) columnValue = TryCast(summary(columnName), String) If Not columnValue Is Nothing AndAlso columnValue.Length > 0 Then summary(columnName) = columnValue & "<br>" & streetDirection.String(k) Else summary(columnName) = streetDirection.String(k) End If k += 1 Loop envelope = streetDirection.Envelope ' Make sure we create a DefinitionSpatialReferenceInfo object in the case ' where the spatial reference has a factory code. Use it for the envelope's ' CoordinateSystem. Otherwise, the envelope's CoordinateSystem will be an ' IDSpatialReferenceInfo object which may cause the map to not draw correctly. Dim spatialReference As ISpatialReference = envelope.SpatialReference Dim spatialReferenceInfo As ESRI.ArcGIS.ADF.Web.SpatialReference.SpatialReferenceInfo = Nothing If Not spatialReference Is Nothing Then If spatialReference.FactoryCode <> 0 Then Dim esriSR As IESRISpatialReferenceGEN = TryCast(envelope.SpatialReference, IESRISpatialReferenceGEN) Dim definition As String = "" Dim bWrote As Integer = 0 esriSR.ExportToESRISpatialReference(definition, bWrote) spatialReferenceInfo = New ESRI.ArcGIS.ADF.Web.SpatialReference.DefinitionSpatialReferenceInfo(definition) End If End If envelope.Expand(1.25, 1.25, True) Dim adf_envelope As ESRI.ArcGIS.ADF.Web.Geometry.Envelope = ESRI.ArcGIS.ADF.Web.DataSources.ArcGISServer.Local.Converter.FromIEnvelope(envelope) If Not spatialReferenceInfo Is Nothing Then adf_envelope.SpatialReference.CoordinateSystem = spatialReferenceInfo End If resultItem.RouteExtent = adf_envelope resultItem.RouteID = streetDirections.RouteID ' Get Directions Dim directions As DataTable = New DataTable("Directions") directions.Columns.Add("Step", GetType(String)) directions.Columns.Add("Directions", GetType(String)) directions.Columns.Add("Length", GetType(String)) directions.Columns.Add("Summary", GetType(String)) directions.Columns.Add("Time", GetType(String)) directions.Columns.Add("Type", GetType(String)) directions.Columns.Add("Cumulative Length", GetType(String)) directions.Columns.Add("Street Name", GetType(String)) directions.Columns.Add("Cross Street", GetType(String)) 'directions.Columns.Add("ETA", typeof(string)); 'directions.Columns.Add("Service Tim", typeof(string)); 'directions.Columns.Add("Time Window", typeof(string)); 'directions.Columns.Add("Violation Time", typeof(string)); 'directions.Columns.Add("Wait Time", typeof(string)); resultItem.StepExtents = New ESRI.ArcGIS.ADF.Web.Geometry.Envelope(streetDirections.DirectionCount - 1) {} Dim j As Integer = 0 Do While j < streetDirections.DirectionCount streetDirection = streetDirections.Direction(j) count = streetDirection.StringCount dataRow = directions.NewRow() directions.Rows.Add(dataRow) k = 0 Do While k < count ' Get type of direction; column name stringType = streetDirection.StringType(k) columnName = GetDirectionsStringType(stringType) If ((stringType = esriDirectionsStringType.esriDSTArrive) Or (stringType = esriDirectionsStringType.esriDSTDepart)) Then directions.Rows(j)("Type") = columnName columnName = "Directions" ElseIf stringType = esriDirectionsStringType.esriDSTGeneral Then directions.Rows(j)("Type") = "General" End If ' Populate column directions.Rows(j)("Step") = j + 1 columnValue = TryCast(directions.Rows(j)(columnName), String) If Not columnValue Is Nothing AndAlso columnValue.Length > 0 Then directions.Rows(j)(columnName) = columnValue & "<br>" & streetDirection.String(k) Else directions.Rows(j)(columnName) = streetDirection.String(k) End If k += 1 Loop envelope = streetDirection.Envelope envelope.Expand(1.25, 1.25, True) adf_envelope = ESRI.ArcGIS.ADF.Web.DataSources.ArcGISServer.Local.Converter.FromIEnvelope(envelope) If Not spatialReferenceInfo Is Nothing Then adf_envelope.SpatialReference.CoordinateSystem = spatialReferenceInfo End If resultItem.StepExtents(j) = adf_envelope j += 1 Loop resultItem.Directions = directions resultItem.Summary = summary nasResultItems.Add(resultItem) i += 1 Loop ' Assume only 1 route in the analysis problem so just return the directions for array[0] Return TryCast(nasResultItems(0), NetworkAnalystRouteResult) End Function ''' <summary> ''' Gets the column name for directions string type ''' </summary> ''' <param name="type">The type to get string for.</param> ''' <returns>The string for direction type.</returns> Public Shared Function GetDirectionsStringType(ByVal type As esriDirectionsStringType) As String Select Case type Case esriDirectionsStringType.esriDSTArrive Return "Arrive" Case esriDirectionsStringType.esriDSTDepart Return "Depart" Case esriDirectionsStringType.esriDSTGeneral Return "Directions" Case esriDirectionsStringType.esriDSTLength Return "Length" Case esriDirectionsStringType.esriDSTSummary Return "Summary" Case esriDirectionsStringType.esriDSTTime Return "Time" Case esriDirectionsStringType.esriDSTCumulativeLength Return "Cumulative Length" Case esriDirectionsStringType.esriDSTEstimatedArrivalTime Return "ETA" Case esriDirectionsStringType.esriDSTServiceTime Return "Service Time" Case esriDirectionsStringType.esriDSTTimeWindow Return "Time Window" Case esriDirectionsStringType.esriDSTViolationTime Return "Violation Time" Case esriDirectionsStringType.esriDSTWaitTime Return "Wait Time" Case esriDirectionsStringType.esriDSTCrossStreet Return "Cross Street" Case esriDirectionsStringType.esriDSTStreetName Return "Street Name" Case Else Return "Default" End Select End Function ''' <summary> ''' Gets the layer using the layer id ''' </summary> ''' <param name="map">The map to which the layer belongs</param> ''' <param name="layerID">The id of the layer</param> ''' <returns>The layer at the id.</returns> Public Shared Function LayerFromLayerID(ByVal gisresource As MapResourceLocal, ByVal layerID As Integer) As ILayer Dim mapContext As IServerContext = gisresource.ServerContextInfo.ServerContext Dim mso As IMapServerObjects = CType(gisresource.MapServer, IMapServerObjects) Dim map As IMap = mso.Map(gisresource.DataFrame) Dim uidINALayer As UID = CType(mapContext.CreateObject("esriSystem.UID"), UID) uidINALayer.Value = "{667B776B-5905-4450-9C94-18B214ECE8FB}" Dim elayers As IEnumLayer = map.Layers(uidINALayer, True) Dim elayer As ILayer = elayers.Next() Dim i As Integer = 0 Do While Not elayer Is Nothing If i = layerID Then Return elayer End If i += 1 elayer = elayers.Next() Loop Return Nothing End Function End Class End Namespace