.\LocateCoordinates\LocateCoordinates.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. ' Public Class LocateCoordinates Private m_pAOInitialize As ESRI.ArcGIS.esriSystem.IAoInitialize Public Sub New() ESRI.ArcGIS.RuntimeManager.Bind(ESRI.ArcGIS.ProductCode.Engine) ' This call is required by the Windows Form Designer. InitializeComponent() 'Get License for controls m_pAOInitialize = New ESRI.ArcGIS.esriSystem.AoInitialize Dim status As ESRI.ArcGIS.esriSystem.esriLicenseStatus status = m_pAOInitialize.IsProductCodeAvailable(ESRI.ArcGIS.esriSystem.esriLicenseProductCode.esriLicenseProductCodeEngineGeoDB) If (status <> ESRI.ArcGIS.esriSystem.esriLicenseStatus.esriLicenseAvailable) Then MsgBox("ERROR: license not available." & vbCrLf & status) Me.Finalize() Else status = m_pAOInitialize.Initialize(ESRI.ArcGIS.esriSystem.esriLicenseProductCode.esriLicenseProductCodeEngineGeoDB) End If 'Add the world continents layer to the map for reference MapControl1.AddLayerFromFile(GetSdkDataPath() + "World\Continents.lyr") End Sub Private Sub MapControl1_OnMouseDown(ByVal sender As System.Object, ByVal e As ESRI.ArcGIS.Controls.IMapControlEvents2_OnMouseDownEvent) Handles MapControl1.OnMouseDown 'clears existing point MapControl1.Refresh() End Sub Private Sub MapControl1_OnMouseUp(ByVal sender As Object, ByVal e As ESRI.ArcGIS.Controls.IMapControlEvents2_OnMouseUpEvent) Handles MapControl1.OnMouseUp Call ConvertCoords(e.mapX, e.mapY) Call DrawPoint(e.mapX, e.mapY) End Sub Private Sub DrawPoint(ByVal mapX, ByVal mapY) On Error GoTo EH Dim pSymbol As ESRI.ArcGIS.Display.IMarkerSymbol Dim pRGB As ESRI.ArcGIS.Display.IRgbColor Dim pPoint As ESRI.ArcGIS.Geometry.IPoint 'Create a point geometry for the markersymbol pPoint = New ESRI.ArcGIS.Geometry.Point pPoint.x = mapX pPoint.y = mapY 'Create a color for the markersymbol pRGB = New ESRI.ArcGIS.Display.RgbColor With pRGB .Red = 0 .Blue = 0 .Green = 0 End With 'Create the markersymbol pSymbol = New ESRI.ArcGIS.Display.SimpleMarkerSymbol With pSymbol .Color = pRGB .Size = 10 End With 'Add the markersymbol to the map at the clicked location MapControl1.DrawShape(pPoint, pSymbol) Exit Sub EH: MsgBox(Err.Number & " " & Err.Description, vbCritical, "Error") End Sub Private Sub ConvertCoords(ByVal mapX, ByVal mapY) On Error GoTo EH Dim pCoordTool As ESRI.ArcGIS.DefenseSolutions.ICoordinateTool Dim vValue As ESRI.ArcGIS.Geometry.IPoint Dim iFormat As Integer Dim vFromDatum As Object Dim vToDatum As Object Dim pWGSPoint As ESRI.ArcGIS.Geometry.IPoint Dim pOutPoint As ESRI.ArcGIS.Geometry.IPoint Dim sDMS As String : sDMS = "" Dim sUTM As String : sUTM = "" Dim sMGRS As String : sMGRS = "" 'Set the parameters to be used in the conversion. 'The parameters are as follows: 'vValue: The input coordinates 'iFormat: The format of the input coordinates, where 1 = IPoint (decimal degrees) ' 2 = DMS ' 3 = UTM ' 4 = MGRS 'vFromDatum: The datum of the input coordinates 'vToDatum: The datum of the output coordinates 'pWGSPoint: The output point with x/y coordinates in WGS1984 datum 'pOutPoint: The output point with x/y coordinates in the output datum 'sDMS: The output DMS coordinates 'sUTM: The output UTM coordinates 'sMGRS: The output MGRS coordinates vValue = New ESRI.ArcGIS.Geometry.Point vValue.PutCoords(mapX, mapY) iFormat = 1 vFromDatum = 0 ' => "WGS 1984 (WGS84)" vToDatum = 0 ' => "WGS 1984 (WGS84)" pWGSPoint = New ESRI.ArcGIS.Geometry.Point pOutPoint = New ESRI.ArcGIS.Geometry.Point pCoordTool = New ESRI.ArcGIS.DefenseSolutions.CoordinateTool pCoordTool.ConvertLocation(vValue, iFormat, vFromDatum, vToDatum, _ pWGSPoint, pOutPoint, sDMS, sUTM, sMGRS) 'Populate the coordinate text boxes with the coordinates calculated 'by the ConvertLocation method. txtX.Text = CStr(pOutPoint.x) txtY.Text = CStr(pOutPoint.y) txtDMS.Text = sDMS txtUTM.Text = sUTM txtMGRS.Text = sMGRS Exit Sub EH: MsgBox(Err.Number & " " & Err.Description, vbCritical, "Error") End Sub Private Function GetSdkDataPath() As String 'get the ArcGIS path from the registry Dim key As Microsoft.Win32.RegistryKey = Microsoft.Win32.Registry.LocalMachine.OpenSubKey("SOFTWARE\ESRI\ArcGIS_SXS_SDK") Dim path As String = Convert.ToString(key.GetValue("InstallDir")) 'set the of the logo Dim str As String = System.IO.Path.Combine(path, "Samples\data\") If (Not System.IO.Directory.Exists(str)) Then MessageBox.Show("Path :" & str & " does not exist!") Return String.Empty End If Return str End Function End Class