SubsetNetworkEvaluatorsUI\SubsetHelperUI.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 System.Drawing Imports System.Collections.Generic Imports System.Runtime.InteropServices Imports System.Windows.Forms Imports ESRI.ArcGIS.ADF.BaseClasses Imports ESRI.ArcGIS.ADF.CATIDs Imports ESRI.ArcGIS.Framework Imports ESRI.ArcGIS.esriSystem Imports ESRI.ArcGIS.Geodatabase Imports ESRI.ArcGIS.Geometry Imports ESRI.ArcGIS.Carto Imports ESRI.ArcGIS.NetworkAnalyst Imports ESRI.ArcGIS.ArcMapUI Imports ESRI.ArcGIS.NetworkAnalystUI Imports SubsetNetworkEvaluators Namespace SubsetNetworkEvaluatorsUI ''' <summary> ''' The SubsetHelperUI is a utility class to aid in determining the relevant set of parameters ''' to auto-update when set to listen to the events and other shared utilities. ''' </summary> Friend Class SubsetHelperUI Public Shared Sub PushParameterValuesToNetwork(ByVal nax As INetworkAnalystExtension) Try If nax Is Nothing Then Return End If Dim naxEnabled As Boolean = False Dim naxConfig As IExtensionConfig = TryCast(nax, IExtensionConfig) naxEnabled = naxConfig.State = esriExtensionState.esriESEnabled If (Not naxEnabled) Then Return End If Dim naWindow As INAWindow = nax.NAWindow Dim naLayer As INALayer = Nothing Dim naContext As INAContext = Nothing Dim nds As INetworkDataset = Nothing naLayer = naWindow.ActiveAnalysis If Not naLayer Is Nothing Then naContext = naLayer.Context End If If Not naContext Is Nothing Then nds = naContext.NetworkDataset End If If nds Is Nothing Then Return End If Dim dsComponent As IDatasetComponent = TryCast(nds, IDatasetComponent) Dim deNet As IDENetworkDataset = TryCast(dsComponent.DataElement, IDENetworkDataset) Dim naSolver As INASolver = naContext.Solver Dim naSolverSettings2 As INASolverSettings2 = TryCast(naSolver, INASolverSettings2) If naSolverSettings2 Is Nothing Then Return End If Dim netAttribute As INetworkAttribute2 Dim attributeName As String Dim netParameters As IArray Dim netParameter As INetworkAttributeParameter Dim paramName As String Dim cParameters As Integer Dim paramValue As Object Dim cAttributes As Integer = nds.AttributeCount Dim a As Integer = 0 Do While a < cAttributes netAttribute = TryCast(nds.Attribute(a), INetworkAttribute2) attributeName = netAttribute.Name netParameters = netAttribute.Parameters cParameters = netParameters.Count Dim p As Integer = 0 Do While p < cParameters netParameter = TryCast(netParameters.Element(p), INetworkAttributeParameter) paramName = netParameter.Name paramValue = naSolverSettings2.AttributeParameterValue(attributeName, paramName) netParameter.Value = paramValue p += 1 Loop netAttribute.Refresh() a += 1 Loop Catch ex As Exception MessageBox.Show(ex.Message, "Push Parameter Values To Network") End Try End Sub Public Shared Function ParameterExists(ByVal nds As INetworkDataset, ByVal searchName As String, ByVal vt As VarType) As Boolean Dim found As Boolean = False Dim netAttribute As INetworkAttribute2 Dim netParams As IArray Dim netParam As INetworkAttributeParameter Dim cAttributes As Integer = nds.AttributeCount Dim a As Integer = 0 Do While a < cAttributes netAttribute = TryCast(nds.Attribute(a), INetworkAttribute2) netParams = Nothing Dim cParams As Integer = 0 If Not netAttribute Is Nothing Then netParams = netAttribute.Parameters End If If Not netParams Is Nothing Then cParams = netParams.Count End If Dim compareName As String Dim p As Integer = 0 Do While p < cParams netParam = TryCast(netParams.Element(p), INetworkAttributeParameter) compareName = netParam.Name If String.Compare(searchName, compareName, True) = 0 Then found = True Exit Do End If p += 1 Loop If found Then Exit Do End If a += 1 Loop Return found End Function Public Shared Sub ClearEIDArrayParameterValues(ByVal nax As INetworkAnalystExtension, ByVal baseName As String) Try Dim naWindow As INAWindow = nax.NAWindow Dim naLayer As INALayer = Nothing Dim naContext As INAContext = Nothing Dim nds As INetworkDataset = Nothing naLayer = naWindow.ActiveAnalysis If Not naLayer Is Nothing Then naContext = naLayer.Context End If If Not naContext Is Nothing Then nds = naContext.NetworkDataset End If If nds Is Nothing Then Return End If Dim vt As VarType = SubsetHelperUI.GetEIDArrayParameterType() Dim sourceNames As List(Of String) = SubsetHelperUI.FindParameterizedSourceNames(nds, baseName, vt) SubsetHelperUI.ClearEIDArrayParameterValues(nax, sourceNames, baseName) SubsetHelperUI.PushParameterValuesToNetwork(nax) Catch ex As Exception Dim msg As String = SubsetHelperUI.GetFullExceptionMessage(ex) MessageBox.Show(msg, "Clear Network Element Array Parameters") End Try End Sub Private Shared Sub ClearEIDArrayParameterValues(ByVal nax As INetworkAnalystExtension, ByVal sourceNames As List(Of String), ByVal baseName As String) If nax Is Nothing Then Return End If Dim naxEnabled As Boolean = False Dim naxConfig As IExtensionConfig = TryCast(nax, IExtensionConfig) naxEnabled = naxConfig.State = esriExtensionState.esriESEnabled If (Not naxEnabled) Then Return End If Dim eidsBySourceName As Dictionary(Of String, List(Of Integer)) = New Dictionary(Of String, List(Of Integer)) For Each sourceName As String In sourceNames Dim eids As List(Of Integer) = Nothing If (Not eidsBySourceName.TryGetValue(sourceName, eids)) Then eidsBySourceName.Add(sourceName, Nothing) End If Next sourceName UpdateEIDArrayParameterValuesFromEIDLists(nax, eidsBySourceName, baseName) End Sub Public Shared Sub UpdateEIDArrayParameterValuesFromEIDLists(ByVal nax As INetworkAnalystExtension, ByVal eidsBySourceName As Dictionary(Of String, List(Of Integer)), ByVal baseName As String) If nax Is Nothing Then Return End If Dim naxEnabled As Boolean = False Dim naxConfig As IExtensionConfig = TryCast(nax, IExtensionConfig) naxEnabled = naxConfig.State = esriExtensionState.esriESEnabled If (Not naxEnabled) Then Return End If Dim naWindow As INAWindow = nax.NAWindow Dim naLayer As INALayer = Nothing Dim naContext As INAContext = Nothing Dim nds As INetworkDataset = Nothing naLayer = naWindow.ActiveAnalysis If Not naLayer Is Nothing Then naContext = naLayer.Context End If If Not naContext Is Nothing Then nds = naContext.NetworkDataset End If If nds Is Nothing Then Return End If Dim dsComponent As IDatasetComponent = TryCast(nds, IDatasetComponent) Dim deNet As IDENetworkDataset = TryCast(dsComponent.DataElement, IDENetworkDataset) Dim naSolver As INASolver = naContext.Solver Dim naSolverSettings2 As INASolverSettings2 = TryCast(naSolver, INASolverSettings2) If naSolverSettings2 Is Nothing Then Return End If Dim prefix As String = GetEIDArrayPrefixFromBaseName(baseName) Dim vt As VarType = GetEIDArrayParameterType() Dim cAttributes As Integer = nds.AttributeCount Dim a As Integer = 0 For a = 0 To cAttributes - 1 Dim netAttribute As INetworkAttribute2 = TryCast(nds.Attribute(a), INetworkAttribute2) Dim netParams As IArray = netAttribute.Parameters Dim cParams As Integer = netParams.Count Dim paramValue As Object Dim p As Integer = 0 For p = 0 To cParams - 1 Dim param As INetworkAttributeParameter = TryCast(netParams.Element(p), INetworkAttributeParameter) If param.VarType <> CInt(vt) Then Continue For End If Dim paramName As String = param.Name Dim sourceName As String = GetSourceNameFromParameterName(prefix, paramName) If sourceName.Length = 0 Then Continue For End If Dim eids As List(Of Integer) = Nothing If eidsBySourceName.TryGetValue(sourceName, eids) Then If Not eids Is Nothing Then If eids.Count = 0 Then eids = Nothing End If End If End If If (Not eids Is Nothing) Then paramValue = eids.ToArray() Else paramValue = Nothing End If naSolverSettings2.AttributeParameterValue(netAttribute.Name, param.Name) = paramValue Next p Next a End Sub Public Shared Sub UpdateEIDArrayParameterValuesFromOIDArrays(ByVal nax As INetworkAnalystExtension, ByVal oidArraysBySourceName As Dictionary(Of String, ILongArray), ByVal baseName As String) Dim eidsBySourceName As Dictionary(Of String, List(Of Integer)) = GetEIDListsBySourceName(nax, oidArraysBySourceName, baseName) UpdateEIDArrayParameterValuesFromEIDLists(nax, eidsBySourceName, baseName) End Sub Public Shared Sub UpdateEIDArrayParameterValuesFromGeometry(ByVal nax As INetworkAnalystExtension, ByVal searchGeometry As IGeometry, ByVal baseName As String) Dim eidsBySourceName As Dictionary(Of String, List(Of Integer)) = GetEIDListsBySourceName(nax, searchGeometry, baseName) UpdateEIDArrayParameterValuesFromEIDLists(nax, eidsBySourceName, baseName) End Sub Private Shared Function GetEIDListsBySourceName(ByVal nax As INetworkAnalystExtension, ByVal searchObject As Object, ByVal baseName As String) As Dictionary(Of String, List(Of Integer)) If nax Is Nothing Then Return Nothing End If Dim naxEnabled As Boolean = False Dim naxConfig As IExtensionConfig = TryCast(nax, IExtensionConfig) naxEnabled = naxConfig.State = esriExtensionState.esriESEnabled If (Not naxEnabled) Then Return Nothing End If Dim naWindow As INAWindow = nax.NAWindow Dim naLayer As INALayer = Nothing Dim naContext As INAContext = Nothing Dim nds As INetworkDataset = Nothing naLayer = naWindow.ActiveAnalysis If Not naLayer Is Nothing Then naContext = naLayer.Context End If If Not naContext Is Nothing Then nds = naContext.NetworkDataset End If Dim netQuery As INetworkQuery = TryCast(nds, INetworkQuery) If netQuery Is Nothing Then Return Nothing End If Dim oidSearch As Boolean = False Dim geometrySearch As Boolean = False If searchObject Is Nothing Then Return Nothing ElseIf TypeOf searchObject Is Dictionary(Of String, ILongArray) Then oidSearch = True ElseIf TypeOf searchObject Is IGeometry Then geometrySearch = True Else Return Nothing End If Dim vt As VarType = GetEIDArrayParameterType() Dim sourceNames As List(Of String) = FindParameterizedSourceNames(nds, baseName, vt) Dim eidsBySourceName As Dictionary(Of String, List(Of Integer)) = New Dictionary(Of String, List(Of Integer)) For Each sourceName As String In sourceNames Dim netSource As INetworkSource = nds.SourceByName(sourceName) Dim sourceID As Integer = netSource.ID Dim eids As List(Of Integer) = New List(Of Integer)() If oidSearch Then Dim oidArraysBySourceName As Dictionary(Of String, ILongArray) = TryCast(searchObject, Dictionary(Of String, ILongArray)) Dim oids As ILongArray = Nothing Dim enumNetElement As IEnumNetworkElement Dim netElement As INetworkElement If oidArraysBySourceName.TryGetValue(sourceName, oids) Then enumNetElement = netQuery.ElementsByOIDs(sourceID, oids) enumNetElement.Reset() netElement = enumNetElement.Next() Do While Not netElement Is Nothing eids.Add(netElement.EID) netElement = enumNetElement.Next() Loop End If ElseIf geometrySearch Then Dim searchGeometry As IGeometry = CType(searchObject, IGeometry) If Not searchGeometry Is Nothing AndAlso (Not searchGeometry.IsEmpty) Then Dim elementGeometry As IGeometry = Nothing Dim elementType As esriNetworkElementType = esriNetworkElementType.esriNETEdge Dim eid As Integer = -1 ' Search for the network dataset layer associated with the active analysis layer or create one using the ' network dataset if matching one not found. ' If, for example, multiple network dataset layers are added to the map, the active analysis layer ' might not reference the current network dataset layer (nax.CurrentNetworkLayer). Dim ndsLayer As INetworkLayer = New NetworkLayerClass() ndsLayer.NetworkDataset = nds Dim count As Integer = nax.NetworkLayerCount Dim i As Integer = 0 Do While i < count ndsLayer = nax.NetworkLayer(i) If ndsLayer.NetworkDataset Is nds Then Exit Do Else ndsLayer = Nothing End If i += 1 Loop If ndsLayer Is Nothing Then ndsLayer = New NetworkLayerClass() ndsLayer.NetworkDataset = nds End If Dim enumLocatedNetElement As IEnumLocatedNetworkElement = Nothing If Not ndsLayer Is Nothing Then enumLocatedNetElement = ndsLayer.SearchLocatedNetworkElements(sourceName, searchGeometry) enumLocatedNetElement.Reset() eid = enumLocatedNetElement.Next(elementGeometry, elementType) Do While eid <> -1 eids.Add(eid) eid = enumLocatedNetElement.Next(elementGeometry, elementType) Loop End If End If End If eidsBySourceName.Add(sourceName, eids) Next sourceName Return eidsBySourceName End Function Public Shared Function GetOIDArraysBySourceNameFromMapSelection(ByVal map As IMap, ByVal sourceNames As List(Of String)) As Dictionary(Of String, ILongArray) Dim uid As UIDClass = New UIDClass() uid.Value = "{E156D7E5-22AF-11D3-9F99-00C04F6BC78E}" 'IGeoFeatureLayer Dim searchEnumLayer As IEnumLayer = map.Layers(uid, True) searchEnumLayer.Reset() 'create result dictionary from source names with empty oidArrays Dim oidArraysBySourceName As Dictionary(Of String, ILongArray) = New Dictionary(Of String, ILongArray)() Dim oidArray As ILongArray = Nothing For Each sourceName As String In sourceNames If (Not oidArraysBySourceName.TryGetValue(sourceName, oidArray)) Then oidArray = New LongArrayClass() oidArraysBySourceName.Add(sourceName, oidArray) End If Next sourceName Dim layer As ILayer = searchEnumLayer.Next() Do While Not layer Is Nothing Dim displayTable As IDisplayTable = TryCast(layer, IDisplayTable) Dim sourceName As String = "" If layer.Valid AndAlso layer.Visible AndAlso Not displayTable Is Nothing Then Dim ds As IDataset = TryCast(displayTable.DisplayTable, IDataset) If Not ds Is Nothing Then sourceName = ds.Name End If End If If sourceName.Length > 0 Then If oidArraysBySourceName.TryGetValue(sourceName, oidArray) Then Dim selSet As ISelectionSet = displayTable.DisplaySelectionSet Dim enumOIDs As IEnumIDs = Nothing If Not selSet Is Nothing Then enumOIDs = selSet.IDs End If If Not enumOIDs Is Nothing Then enumOIDs.Reset() Dim oid As Integer = enumOIDs.Next() Do While oid <> -1 oidArray.Add(oid) oid = enumOIDs.Next() Loop End If End If End If layer = searchEnumLayer.Next() Loop Return oidArraysBySourceName End Function Public Shared Function GetSearchGeometryFromGraphics(ByVal graphics As IGraphicsContainer) As IGeometry Dim geometryBag As IGeometryCollection = New GeometryBagClass() Dim element As IElement Dim geometry As IGeometry graphics.Reset() element = graphics.Next() Dim before As Object = Type.Missing Dim after As Object = Type.Missing Do While Not element Is Nothing geometry = element.Geometry If TypeOf geometry Is IPolygon Then geometryBag.AddGeometry(geometry, before, after) End If element = graphics.Next() Loop Dim searchGeometry As IGeometry = TryCast(geometryBag, IGeometry) Return searchGeometry End Function Public Shared Function FindParameterizedSourceNames(ByVal nds As INetworkDataset, ByVal baseName As String, ByVal vt As VarType) As List(Of String) Dim sourceNamesList As List(Of String) = New List(Of String)() Dim sourceNamesDictionary As Dictionary(Of String, Nullable(Of Integer)) = New Dictionary(Of String, Nullable(Of Integer)) Dim dummyValue As Nullable(Of Integer) = Nothing Dim foundDummyValue As Nullable(Of Integer) = Nothing Dim prefix As String = GetEIDArrayPrefixFromBaseName(baseName) Dim netSource As INetworkSource Dim sourceName As String Dim searchParamName As String Dim count As Integer = nds.SourceCount Dim i As Integer = 0 For i = 0 To count - 1 netSource = nds.Source(i) sourceName = netSource.Name If sourceNamesDictionary.TryGetValue(sourceName, foundDummyValue) Then Continue For End If searchParamName = GetSourceParameterName(prefix, sourceName) If ParameterExists(nds, searchParamName, vt) Then sourceNamesList.Add(sourceName) sourceNamesDictionary.Add(sourceName, dummyValue) End If Next i Return sourceNamesList End Function Public Shared Function GetEIDArrayParameterType() As VarType Dim vt As VarType = VarType.Array Or VarType.Integer Return vt End Function Public Shared ReadOnly Property SelectionEIDArrayBaseName() As String Get Return FilterSubsetEvaluator.BaseParameterName End Get End Property Public Shared ReadOnly Property GraphicsEIDArrayBaseName() As String Get Return ScaleSubsetEvaluator.BaseParameterName End Get End Property Private Shared Function GetEIDArrayPrefixFromBaseName(ByVal baseName As String) As String Dim baseNameEIDArrayModifer As String = "_eids" Dim prefix As String = baseName prefix &= baseNameEIDArrayModifer Return prefix End Function Private Shared Function GetSourceNameFromParameterName(ByVal prefix As String, ByVal paramName As String) As String Dim searchSubName As String = prefix & "_" Dim searchSubNameLen As Integer = searchSubName.Length Dim paramNameLen As Integer = paramName.Length If searchSubNameLen <= 0 OrElse searchSubNameLen >= paramNameLen Then Return "" End If Dim compareSubName As String = paramName.Substring(0, searchSubNameLen) If String.Compare(compareSubName, searchSubName, True) <> 0 Then Return "" End If Dim sourceName As String = paramName.Substring(searchSubNameLen) Return sourceName End Function Private Shared Function GetSourceParameterName(ByVal prefix As String, ByVal sourceName As String) As String Dim paramName As String = prefix paramName &= "_" paramName &= sourceName Return paramName End Function Public Shared Function GetNAXConfiguration(ByVal app As IApplication) As IExtensionConfig Dim extConfig As IExtensionConfig = Nothing Try If Not app Is Nothing Then Dim extCLSID As UID = New UIDClass() extCLSID.Value = "{C967BD39-1118-42EE-AAAB-B31642C89C3E}" ' Network Analyst extConfig = TryCast(app.FindExtensionByCLSID(extCLSID), IExtensionConfig) End If Catch extConfig = Nothing End Try Return extConfig End Function Public Shared Function GetFullExceptionMessage(ByVal ex As Exception) As String Dim msg As String = "" Dim subMsg As String = "" Do While Not ex Is Nothing subMsg = ex.Message If subMsg.Length > 0 AndAlso msg.Length > 0 Then msg &= Constants.vbLf End If msg &= subMsg ex = ex.InnerException Loop Return msg End Function End Class End Namespace