NAClassToTextfileCmd.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. ' Imports Microsoft.VisualBasic Imports System Imports System.IO Imports System.Windows.Forms Imports System.Drawing Imports System.Runtime.InteropServices Imports System.Reflection Imports ESRI.ArcGIS.Framework Imports ESRI.ArcGIS.NetworkAnalyst Imports ESRI.ArcGIS.Carto Imports ESRI.ArcGIS.Geometry Imports ESRI.ArcGIS.Geodatabase Imports ESRI.ArcGIS.NetworkAnalystUI Namespace ExportNAClass ''' <summary> ''' This sample command allows you export a text file version ''' of the active class in the Network Analyst window after ''' completion of a successful solve. ''' </summary> ''' <ClassInterface(ClassInterfaceType.None), Guid("7C12A530-759A-4B12-9241-2215403483E8"), ProgId("ExportNAClass.NAClassToTextfileCmd")> _ Public NotInheritable Class NAClassToTextfileCmd : Inherits ESRI.ArcGIS.ADF.BaseClasses.BaseCommand : Implements INAWindowCommand Private Const DELIMITER As String = Constants.vbTab Private m_naExt As INetworkAnalystExtension ' set up the bitmap for the command icon <DllImport("gdi32.dll")> _ Shared Function DeleteObject(ByVal hObject As IntPtr) As Boolean End Function Private Shadows m_bitmap As System.Drawing.Bitmap Private m_hBitmap As IntPtr Public Sub New() ESRI.ArcGIS.RuntimeManager.Bind(ESRI.ArcGIS.ProductCode.Desktop) ' set up the bitmap transparency Dim res As String() = Me.GetType().Assembly.GetManifestResourceNames() If res.GetLength(0) > 0 Then m_bitmap = New System.Drawing.Bitmap(Me.GetType().Assembly.GetManifestResourceStream(res(0))) If Not m_bitmap Is Nothing Then m_bitmap.MakeTransparent(m_bitmap.GetPixel(0, 0)) m_hBitmap = m_bitmap.GetHbitmap() End If End If End Sub Protected Overrides Sub Finalize() If m_hBitmap.ToInt32() <> 0 Then DeleteObject(m_hBitmap) End If End Sub #Region "Component Category Registration" <ComRegisterFunction()> _ Private Shared Sub Reg(ByVal regKey As String) ESRI.ArcGIS.ADF.CATIDs.ControlsCommands.Register(regKey) ESRI.ArcGIS.ADF.CATIDs.MxCommands.Register(regKey) ' Register with NetworkAnalystWindowCategoryCommand to get the ' command to show up when you right click on the class in the NAWindow ESRI.ArcGIS.ADF.CATIDs.NetworkAnalystWindowCategoryCommand.Register(regKey) End Sub <ComUnregisterFunction()> _ Private Shared Sub Unreg(ByVal regKey As String) ESRI.ArcGIS.ADF.CATIDs.ControlsCommands.Unregister(regKey) ESRI.ArcGIS.ADF.CATIDs.MxCommands.Unregister(regKey) End Sub #End Region #Region "NAWindow Interaction" Private Function GetActiveAnalysisLayer() As INALayer If Not m_naExt Is Nothing Then Return m_naExt.NAWindow.ActiveAnalysis Else Return Nothing End If End Function Private Function GetActiveCategory() As INAWindowCategory2 ' Remove the next 2 lines for an engine only install If Not m_naExt Is Nothing Then Return TryCast(m_naExt.NAWindow.ActiveCategory, INAWindowCategory2) Else Return Nothing End If End Function #End Region #Region "Overridden BaseCommand Methods" Public Overrides Sub OnCreate(ByVal hook As Object) ' Try to get the network analyst extension from the desktop app's extensions Dim app As IApplication app = TryCast(hook, IApplication) If Not app Is Nothing Then m_naExt = TryCast(app.FindExtensionByName("Network Analyst"), INetworkAnalystExtension) End If End Sub ''' <summary> ''' This command will be enabled only for a NAClass ''' associated with a successful solve ''' </summary> Public Overrides ReadOnly Property Enabled() As Boolean Get ' there must be an active analysis layer Dim naLayer As INALayer = GetActiveAnalysisLayer() If Not naLayer Is Nothing Then ' the context must be valid Dim naContext As INAContext = naLayer.Context If Not naContext Is Nothing Then Return True End If End If Return False End Get End Property Public Overrides ReadOnly Property Message() As String Get Return "Export a network analysis class to a text file." End Get End Property Public Overrides ReadOnly Property Bitmap() As Integer Get Return m_hBitmap.ToInt32() End Get End Property Public Overrides ReadOnly Property Tooltip() As String Get Return "Export a network analysis class to a text file." End Get End Property Public Overrides ReadOnly Property Name() As String Get Return "NAClassToTextFileCmd" End Get End Property Public Overrides ReadOnly Property Caption() As String Get Return "Export To text file..." End Get End Property Public Overrides ReadOnly Property Category() As String Get Return "Developer Samples" End Get End Property Public Overrides Sub OnClick() Try ExportToText() Catch exception As Exception MessageBox.Show(exception.Message, "Error") End Try End Sub #End Region #Region "Overridden INAWindowCommand Methods" Public Function Applies(ByVal naLayer As INALayer, ByVal Category As INAWindowCategory) As Boolean Implements ESRI.ArcGIS.NetworkAnalystUI.INAWindowCommand.Applies Return True End Function #End Region Private Sub ExportToText() Dim sfDialog As SaveFileDialog = New SaveFileDialog() SetUpSaveDialog(sfDialog) ' generate the dialog and verify the user successfully clicked save Dim dResult As DialogResult = sfDialog.ShowDialog() If dResult = System.Windows.Forms.DialogResult.OK Then ' set up the text file to be written Dim t As FileInfo = New FileInfo(sfDialog.FileName) Dim swText As StreamWriter = t.CreateText() Dim table As ITable = TryCast(GetActiveCategory().DataLayer, ITable) ' write the first line of the text file as column headers swText.WriteLine(GenerateColumnHeaderString(table)) ' iterate through the table associated with the class ' to write out each line of data into the text file Dim cursor As ICursor = table.Search(Nothing, True) Dim row As IRow = cursor.NextRow() Do While Not row Is Nothing swText.WriteLine(GenerateDataString(row)) row = cursor.NextRow() Loop swText.Close() End If End Sub Private Sub SetUpSaveDialog(ByRef sfDialog As SaveFileDialog) sfDialog.AddExtension = True sfDialog.Title = "Save an export of the specified class in the active analysis..." sfDialog.DefaultExt = "txt" sfDialog.OverwritePrompt = True sfDialog.FileName = "ClassExport.txt" sfDialog.Filter = "Text files (*.txt;*.csv;*.asc;*.tab)|*.txt;*.tab;*.asc;*.csv" sfDialog.InitialDirectory = "c:\" End Sub Private Function GenerateColumnHeaderString(ByRef table As ITable) As String Dim field As IField = Nothing ' export the names of the fields (tab delimited) as the first line of the export Dim fieldNames As String = "" Dim i As Integer = 0 Do While i < table.Fields.FieldCount field = table.Fields.Field(i) If i > 0 Then fieldNames &= DELIMITER End If Dim columnName As String = field.Name.ToString() ' point classes have a special output of X and Y, other classes just output "Shape" If field.Type = esriFieldType.esriFieldTypeGeometry Then If field.GeometryDef.GeometryType = esriGeometryType.esriGeometryPoint Then columnName = "X" columnName &= DELIMITER columnName &= "Y" End If End If fieldNames &= columnName i += 1 Loop Return fieldNames End Function Private Function GenerateDataString(ByRef row As IRow) As String Dim textOut As String = "" ' On a zero-based index, iterate through the fields in the collection. Dim i As Integer = 0 Do While i < row.Fields.FieldCount If i > 0 Then textOut &= DELIMITER End If Dim field As IField = row.Fields.Field(i) ' for shape fields in a point layer, export the associated X and Y coordinates If field.Type = esriFieldType.esriFieldTypeGeometry Then If field.GeometryDef.GeometryType = esriGeometryType.esriGeometryPoint Then ' x y location information must be retrieved from the Feature Dim point As IPoint = TryCast(row.Value(i), ESRI.ArcGIS.Geometry.Point) textOut &= point.X.ToString() textOut &= DELIMITER textOut &= point.Y.ToString() Else textOut &= "Shape" End If Else textOut &= row.Value(i).ToString() End If i += 1 Loop Return textOut End Function End Class End Namespace