The code in my window that contains several drawing options...a buffered point, a polygon, a rectangle, etc. I have another class DrawTool that handles the OnMouseDown action Private Sub Draw_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnPoint.Click, btnPolygon.Click, btnFreehand.Click, btnRectangle.Click Dim pUID As New ESRI.ArcGIS.esriSystem.UID Dim pCommandItem As ESRI.ArcGIS.Framework.ICommandItem Try pUID.Value = My.ThisAddIn.IDs.DrawTool pCommandItem = m_application.Document.CommandBars.Find(pUID, False, False) Select Case sender.name Case "btnPoint" 'this contains code for specific actions for the point button Case "btnFreehand" 'this contains code for specific actions for the freehand button End Select Me.Visible = False m_application.CurrentTool = pCommandItem Catch ex As Exception System.Windows.Forms.MessageBox.Show(ex.ToString, "Open Draw Feature") End Try End Sub
Public Class DrawTool Inherits ESRI.ArcGIS.Desktop.AddIns.Tool Private graphicsContainer As ESRI.ArcGIS.Carto.IGraphicsContainer Private m_LineFeedback As ESRI.ArcGIS.Display.INewBezierCurveFeedback = Nothing Protected Overrides Sub OnMouseDown(ByVal arg As ESRI.ArcGIS.Desktop.AddIns.Tool.MouseEventArgs) MyBase.OnMouseDown(arg) Try Dim activeView As ESRI.ArcGIS.Carto.IActiveView = My.ArcMap.Document.ActiveView Dim pGeometry As ESRI.ArcGIS.Geometry.IGeometry5 = GetFeatureFromMouse(activeView, arg.X, arg.Y) Dim rgbColor As ESRI.ArcGIS.Display.IRgbColor = New ESRI.ArcGIS.Display.RgbColorClass() Dim FillStyle As ESRI.ArcGIS.Display.esriSimpleFillStyle rgbColor.Red = 255 FillStyle = ESRI.ArcGIS.Display.esriSimpleFillStyle.esriSFSBackwardDiagonal If pGeometry Is Nothing Then Exit Sub AddGraphicToMap(pGeometry, rgbColor, rgbColor, FillStyle) 'this is the ArcGIS snippet "Add Graphic to Map" Catch ex As Exception System.Windows.Forms.MessageBox.Show(ex.ToString) Finally m_DrawFeature.Visible = True 'This is the form with the buttons End Try End Sub Public Function GetFeatureFromMouse(activeView As ESRI.ArcGIS.Carto.IActiveView, XVal As Integer, YVal As Integer) As ESRI.ArcGIS.Geometry.IGeometry5 Dim screenDisplay As ESRI.ArcGIS.Display.IScreenDisplay = activeView.ScreenDisplay Dim pRubberBand As ESRI.ArcGIS.Display.IRubberBand2 Dim pPoint As ESRI.ArcGIS.Geometry.IPoint Dim pPolygon As ESRI.ArcGIS.Geometry.IPolygon4 Dim pGeometry As ESRI.ArcGIS.Geometry.IGeometry5 Dim pPolyLine As ESRI.ArcGIS.Geometry.IPolyline6 Try Select Case Globals.DrawFeatureType Case "Point" pRubberBand = New ESRI.ArcGIS.Display.RubberPoint pPoint = pRubberBand.TrackNew(screenDisplay, Nothing) Return pPoint Case "Polygon" pRubberBand = New ESRI.ArcGIS.Display.RubberPolygon pPolygon = pRubberBand.TrackNew(screenDisplay, Nothing) Return pPolygon Case "Rectangle" pRubberBand = New ESRI.ArcGIS.Display.RubberEnvelope pGeometry = pRubberBand.TrackNew(screenDisplay, Nothing) Return pGeometry Case "Freehand" pPoint = activeView.ScreenDisplay.DisplayTransformation.ToMapPoint(XVal, YVal) If m_LineFeedback Is Nothing Then m_LineFeedback = New ESRI.ArcGIS.Display.NewBezierCurveFeedback m_LineFeedback.Display = screenDisplay m_LineFeedback.Start(pPoint) Return Nothing Else pPolyLine = m_LineFeedback.Stop m_LineFeedback = Nothing pPolygon = CreatePolygonfromPolyline(pPolyLine) Return pPolygon End If Case Else System.Windows.Forms.MessageBox.Show("Not coded yet") Return Nothing End Select Catch ex As Exception System.Windows.Forms.MessageBox.Show(ex.ToString, "Get Feature") Return Nothing End Try End Function Private Function CreatePolygonfromPolyline(pPolyline As ESRI.ArcGIS.Geometry.IPolyline6) As ESRI.ArcGIS.Geometry.IPolygon4 Try Dim pOutCollection As ESRI.ArcGIS.Geometry.IPointCollection4 = New ESRI.ArcGIS.Geometry.Polygon Dim pPolygon As ESRI.ArcGIS.Geometry.IPolygon4 pOutCollection.AddPointCollection(pPolyline) pPolygon = pOutCollection pPolygon.Close() Return pPolygon Catch ex As Exception System.Windows.Forms.MessageBox.Show(ex.ToString, "Conversion error") Return Nothing End Try End Function
Dim commandItem As ESRI.ArcGIS.Framework.ICommandItem = _application.Document.CommandBars.Find(UIDCls)
Imports System.Runtime.InteropServices Imports System.Drawing Imports ESRI.ArcGIS.ADF.BaseClasses Imports ESRI.ArcGIS.ADF.CATIDs Imports ESRI.ArcGIS.Framework Imports ESRI.ArcGIS.ArcMapUI Imports System.Windows.Forms Imports ESRI.ArcGIS.Geometry Imports ESRI.ArcGIS.SystemUI <ComClass(CoordinateSelectorTool.ClassId, CoordinateSelectorTool.InterfaceId, CoordinateSelectorTool.EventsId), _ ProgId("CTM.GIS.GISDesktop.CoordinateSelectorTool")> _ Public NotInheritable Class CoordinateSelectorTool Inherits BaseTool Implements ICommand #Region "COM GUIDs" ' These GUIDs provide the COM identity for this class ' and its COM interfaces. If you change them, existing ' clients will no longer be able to access the class. Public Const ClassId As String = "94ea5994-2e62-44b7-8786-a0d0075e91e8" Public Const InterfaceId As String = "f0bad365-71c4-4e83-ab96-54d6f0f0e904" Public Const EventsId As String = "8899000e-aa7c-424e-a34a-38ab47c9cc79" #End Region #Region "COM Registration Function(s)" <ComRegisterFunction(), ComVisibleAttribute(False)> _ Public Shared Sub RegisterFunction(ByVal registerType As Type) ' Required for ArcGIS Component Category Registrar support ArcGISCategoryRegistration(registerType) 'Add any COM registration code after the ArcGISCategoryRegistration() call End Sub <ComUnregisterFunction(), ComVisibleAttribute(False)> _ Public Shared Sub UnregisterFunction(ByVal registerType As Type) ' Required for ArcGIS Component Category Registrar support ArcGISCategoryUnregistration(registerType) 'Add any COM unregistration code after the ArcGISCategoryUnregistration() call End Sub #Region "ArcGIS Component Category Registrar generated code" Private Shared Sub ArcGISCategoryRegistration(ByVal registerType As Type) Dim regKey As String = String.Format("HKEY_CLASSES_ROOT\CLSID\{{{0}}}", registerType.GUID) MxCommands.Register(regKey) End Sub Private Shared Sub ArcGISCategoryUnregistration(ByVal registerType As Type) Dim regKey As String = String.Format("HKEY_CLASSES_ROOT\CLSID\{{{0}}}", registerType.GUID) MxCommands.Unregister(regKey) End Sub #End Region #End Region Public m_application As IApplication Public ClickPoint As IPoint Public ReturnForm As System.Windows.Forms.Form Public _arcmap As IMxDocument Public myExt As ESRI.ArcGIS.esriSystem.IExtension ' A creatable COM class must have a Public Sub New() ' with no parameters, otherwise, the class will not be ' registered in the COM registry and cannot be created ' via CreateObject. Public Sub New() MyBase.New() ' TODO: Define values for the public properties ' TODO: Define values for the public properties MyBase.m_category = "" 'localizable text MyBase.m_caption = "" 'localizable text MyBase.m_message = "" 'localizable text MyBase.m_toolTip = "" 'localizable text MyBase.m_name = "" 'unique id, non-localizable (e.g. "MyCategory_ArcMapTool") Try 'TODO: change resource name if necessary Dim bitmapResourceName As String = Me.GetType().Name + ".bmp" MyBase.m_bitmap = New Bitmap(Me.GetType(), bitmapResourceName) MyBase.m_cursor = New System.Windows.Forms.Cursor(Me.GetType(), Me.GetType().Name + ".cur") 'Dim document As IDocument = CType(_arcmap.CurrentDocument, IDocument) 'm_application = document.Parent OnClick() Catch ex As Exception System.Diagnostics.Trace.WriteLine(ex.Message, "Invalid Bitmap") End Try End Sub Public Overrides Sub OnCreate(ByVal hook As Object) If Not hook Is Nothing Then m_application = CType(hook, IApplication) _arcmap = m_application.Document CoordinateSelectorTool.ArcGISCategoryRegistration(Me.GetType()) CoordinateSelectorTool.RegisterFunction(Me.GetType()) 'Disable if it is not ArcMap If TypeOf hook Is IMxApplication Then MyBase.m_enabled = True Me.OnClick() myExt = m_application.FindExtensionByName("CTM.GIS.GISDesktop.CoordinateSelectorTool") Else MyBase.m_enabled = False End If End If ' TODO: Add other initialization code End Sub Public Overrides Sub OnClick() 'TODO: Add CoordinateSelectorTool.OnClick implementation End Sub Public Overrides Sub OnMouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Integer, ByVal Y As Integer) Dim pMxDoc As IMxDocument pMxDoc = m_application.Document ClickPoint = pMxDoc.ActiveView.ScreenDisplay.DisplayTransformation.ToMapPoint(X, Y) 'TODO: Add CoordinateSelectorTool.OnMouseDown implementation End Sub Public Overrides Sub OnMouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Integer, ByVal Y As Integer) 'TODO: Add CoordinateSelectorTool.OnMouseMove implementation End Sub Public Overrides Sub OnMouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Integer, ByVal Y As Integer) 'TODO: Add CoordinateSelectorTool.OnMouseUp implementation End Sub Public Sub SetForm(m_form As System.Windows.Forms.Form) If (m_form IsNot Nothing) Then ReturnForm = m_form End If End Sub Protected Sub ShowForm() If (ReturnForm IsNot Nothing) Then ReturnForm.Show() End If End Sub End Class