Turn on suggestions
Auto-suggest helps you quickly narrow down your search results by suggesting possible matches as you type.
Cancel
- Home
- :
- All Communities
- :
- Developers
- :
- ArcObjects SDK
- :
- ArcObjects SDK Questions
- :
- trouble migrating vba to .net for draw polygon buf...
Options
- Subscribe to RSS Feed
- Mark Topic as New
- Mark Topic as Read
- Float this Topic for Current User
- Bookmark
- Subscribe
- Mute
- Printer Friendly Page
trouble migrating vba to .net for draw polygon buffers
Subscribe
1374
1
12-07-2011 04:57 AM
12-07-2011
04:57 AM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Hi,
I'm new to .net and trying to adapt a version of the vba sample below to work as an add-in tool.
Here's the original: http://resources.esri.com/help/9.3/arcgisdesktop/com/samples/arcmap/83691e5d-1029-463c-b87a-0f40519f...
I think I'm getting stuck on calling the mousedown and active view events.
Any help would be greatly appreciated.
Thanks,
Ben
'Draws 1/4 mile buffer on top most polygon layer.
Option Explicit On
Imports ESRI.ArcGIS.esriSystem
Imports ESRI.ArcGIS.ArcMapUI
Imports ESRI.ArcGIS.Carto
Imports ESRI.ArcGIS.Geometry
Imports ESRI.ArcGIS.Display
Imports ESRI.ArcGIS.Geodatabase
Imports ESRI.ArcGIS.ArcCatalog
Public Class NitrateBufferTool
Inherits ESRI.ArcGIS.Desktop.AddIns.Tool
Private WithEvents ActiveViewEvents As Map
Private m_pMxDoc As IMxDocument
Private m_pBufferPolygon As IPolygon
Private m_pLastBufferedExtent As IEnvelope
Private m_pFillSymbol As ISimpleFillSymbol
Private m_pOutlineSymbol As ISimpleLineSymbol
Public Sub New()
End Sub
Protected Overrides Sub OnUpdate()
Enabled = My.ArcMap.Application IsNot Nothing
End Sub
Private Sub ActiveViewEvents_AfterItemDraw(ByVal Index As Integer, ByVal display As IDisplay, ByVal phase As ESRI.ArcGIS.esriSystem.esriDrawPhase)
'Only draw in the geography phase
If Not phase = ESRI.ArcGIS.esriSystem.esriDrawPhase.esriDPGeography Then Exit Sub
'Draw the buffered polygon
If m_pBufferPolygon Is Nothing Then Exit Sub
With display
.SetSymbol(m_pFillSymbol)
.DrawPolygon(m_pBufferPolygon)
End With
End Sub
Private Sub ActiveViewEvents_SelectionChanged()
Dim pActiveView As IActiveView
Dim pEnumFeature As IEnumFeature
Dim pFeature As IFeature
Dim pPolygon As IPolygon
Dim pTopoOperator As ITopologicalOperator
Dim pGeometryBag As IGeometryCollection
pActiveView = m_pMxDoc.FocusMap
pGeometryBag = New GeometryBag
'Flag last buffered region for invalidation
If Not m_pLastBufferedExtent Is Nothing Then
pActiveView.PartialRefresh(esriViewDrawPhase.esriViewGeography, Nothing, m_pLastBufferedExtent)
End If
If m_pMxDoc.FocusMap.SelectionCount = 0 Then
'Nothing selected; don't draw anything; bail
m_pBufferPolygon = Nothing
Exit Sub
End If
'Buffer each selected feature
pEnumFeature = m_pMxDoc.FocusMap.FeatureSelection
pEnumFeature.Reset()
pFeature = pEnumFeature.Next
Do While Not pFeature Is Nothing
pTopoOperator = pFeature.Shape
pPolygon = pTopoOperator.Buffer(1320)
pGeometryBag.AddGeometry(pPolygon)
'Get next feature
pFeature = pEnumFeature.Next
Loop
'Union all the buffers into one polygon
m_pBufferPolygon = New Polygon
pTopoOperator = m_pBufferPolygon 'QI
pTopoOperator.ConstructUnion(pGeometryBag)
m_pLastBufferedExtent = m_pBufferPolygon.Envelope
'Flag new buffered region for invalidation
pActiveView.PartialRefresh(esriViewDrawPhase.esriViewGeography, Nothing, m_pBufferPolygon.Envelope)
'Zoom to the buffer extent
Dim pEnvelope As IEnvelope
pEnvelope = New Envelope
pEnvelope.PutCoords(m_pBufferPolygon.Envelope.XMin - 1, m_pBufferPolygon.Envelope.YMin - 1, _
m_pBufferPolygon.Envelope.XMax + 1, m_pBufferPolygon.Envelope.YMax + 1)
pEnvelope.Expand(1, 1, True)
pActiveView.Extent = pEnvelope
pActiveView.Refresh()
End Sub
Private Sub OnMouseDown(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long)
MsgBox("mousedown")
Dim pMxApp As IMxApplication
Dim pMxDoc As IMxDocument
Dim pMap As IMap
Dim pActiveView As IActiveView
Dim pEnvelope As IEnvelope
Dim pRubberEnv As IRubberBand
Dim MxStatusBar As IStatusBar
Dim pProgAnim As IAnimationProgressor
pRubberEnv = New RubberEnvelope
pMxApp = My.ArcMap.Application
pMxDoc = pMxApp.Document
pMap = pMxDoc.FocusMap
pActiveView = pMap
pProgAnim = MxStatusBar.ProgressAnimation
pEnvelope = pMxDoc.CurrentLocation.Envelope
pEnvelope.Expand(pMxDoc.SearchTolerance, pMxDoc.SearchTolerance, False)
'Refresh the old selection to erase it
pActiveView.PartialRefresh(esriViewDrawPhase.esriViewGeoSelection, Nothing, Nothing)
If shift = 1 Then
pMxApp.SelectionEnvironment.CombinationMethod = ESRI.ArcGIS.Carto.esriSelectionResultEnum.esriSelectionResultXOR
Else
pMxApp.SelectionEnvironment.CombinationMethod = ESRI.ArcGIS.Carto.esriSelectionResultEnum.esriSelectionResultNew
End If
'Play the progress animation
pProgAnim.Show()
pProgAnim.Play()
MxStatusBar.PlayProgressAnimation(True)
'Perform the selection using a point created on mouse down
pMap.SelectByShape(pEnvelope, pMxApp.SelectionEnvironment, True)
'Refresh again to draw the new selection
pActiveView.PartialRefresh(esriViewDrawPhase.esriViewGeoSelection, Nothing, Nothing)
End Sub
Protected Overrides Sub OnActivate()
MsgBox("OnActivate")
Dim pMap As IMap
Dim pActiveView As IActiveView
Dim pFeatureLayer As IFeatureLayer
Dim pGC As IGraphicsContainer
Dim pViewManager As IViewManager
Dim pRgbColor As IRgbColor
Dim MxStatusBar As IStatusBar
Dim pProgAnim As IAnimationProgressor
m_pMxDoc = My.ArcMap.Document
pMap = m_pMxDoc.FocusMap
pActiveView = m_pMxDoc.ActiveView
MxStatusBar = My.ArcMap.Application.StatusBar
pGC = pMap
pGC.DeleteAllElements()
pViewManager = m_pMxDoc.FocusMap
pViewManager.VerboseEvents = True
ActiveViewEvents = m_pMxDoc.FocusMap
'Play some progress animation
pProgAnim = MxStatusBar.ProgressAnimation
pProgAnim.Show()
pProgAnim.Play()
MxStatusBar.PlayProgressAnimation(True)
'Create the fill symbol
m_pFillSymbol = New SimpleFillSymbol
m_pOutlineSymbol = m_pFillSymbol.Outline
m_pFillSymbol.Style = ESRI.ArcGIS.Display.esriSimpleFillStyle.esriSFSHollow
'Create the outline symbol
m_pOutlineSymbol.Style = ESRI.ArcGIS.Display.esriSimpleLineStyle.esriSLSSolid
m_pOutlineSymbol.Width = 4
pRgbColor = New RgbColor
pRgbColor.Red = 197
pRgbColor.Green = 0
pRgbColor.Blue = 255
m_pOutlineSymbol.Color = pRgbColor
m_pFillSymbol.Outline = m_pOutlineSymbol
MsgBox("finished OnActivate")
End Sub
End Class
I'm new to .net and trying to adapt a version of the vba sample below to work as an add-in tool.
Here's the original: http://resources.esri.com/help/9.3/arcgisdesktop/com/samples/arcmap/83691e5d-1029-463c-b87a-0f40519f...
I think I'm getting stuck on calling the mousedown and active view events.
Any help would be greatly appreciated.
Thanks,
Ben
'Draws 1/4 mile buffer on top most polygon layer.
Option Explicit On
Imports ESRI.ArcGIS.esriSystem
Imports ESRI.ArcGIS.ArcMapUI
Imports ESRI.ArcGIS.Carto
Imports ESRI.ArcGIS.Geometry
Imports ESRI.ArcGIS.Display
Imports ESRI.ArcGIS.Geodatabase
Imports ESRI.ArcGIS.ArcCatalog
Public Class NitrateBufferTool
Inherits ESRI.ArcGIS.Desktop.AddIns.Tool
Private WithEvents ActiveViewEvents As Map
Private m_pMxDoc As IMxDocument
Private m_pBufferPolygon As IPolygon
Private m_pLastBufferedExtent As IEnvelope
Private m_pFillSymbol As ISimpleFillSymbol
Private m_pOutlineSymbol As ISimpleLineSymbol
Public Sub New()
End Sub
Protected Overrides Sub OnUpdate()
Enabled = My.ArcMap.Application IsNot Nothing
End Sub
Private Sub ActiveViewEvents_AfterItemDraw(ByVal Index As Integer, ByVal display As IDisplay, ByVal phase As ESRI.ArcGIS.esriSystem.esriDrawPhase)
'Only draw in the geography phase
If Not phase = ESRI.ArcGIS.esriSystem.esriDrawPhase.esriDPGeography Then Exit Sub
'Draw the buffered polygon
If m_pBufferPolygon Is Nothing Then Exit Sub
With display
.SetSymbol(m_pFillSymbol)
.DrawPolygon(m_pBufferPolygon)
End With
End Sub
Private Sub ActiveViewEvents_SelectionChanged()
Dim pActiveView As IActiveView
Dim pEnumFeature As IEnumFeature
Dim pFeature As IFeature
Dim pPolygon As IPolygon
Dim pTopoOperator As ITopologicalOperator
Dim pGeometryBag As IGeometryCollection
pActiveView = m_pMxDoc.FocusMap
pGeometryBag = New GeometryBag
'Flag last buffered region for invalidation
If Not m_pLastBufferedExtent Is Nothing Then
pActiveView.PartialRefresh(esriViewDrawPhase.esriViewGeography, Nothing, m_pLastBufferedExtent)
End If
If m_pMxDoc.FocusMap.SelectionCount = 0 Then
'Nothing selected; don't draw anything; bail
m_pBufferPolygon = Nothing
Exit Sub
End If
'Buffer each selected feature
pEnumFeature = m_pMxDoc.FocusMap.FeatureSelection
pEnumFeature.Reset()
pFeature = pEnumFeature.Next
Do While Not pFeature Is Nothing
pTopoOperator = pFeature.Shape
pPolygon = pTopoOperator.Buffer(1320)
pGeometryBag.AddGeometry(pPolygon)
'Get next feature
pFeature = pEnumFeature.Next
Loop
'Union all the buffers into one polygon
m_pBufferPolygon = New Polygon
pTopoOperator = m_pBufferPolygon 'QI
pTopoOperator.ConstructUnion(pGeometryBag)
m_pLastBufferedExtent = m_pBufferPolygon.Envelope
'Flag new buffered region for invalidation
pActiveView.PartialRefresh(esriViewDrawPhase.esriViewGeography, Nothing, m_pBufferPolygon.Envelope)
'Zoom to the buffer extent
Dim pEnvelope As IEnvelope
pEnvelope = New Envelope
pEnvelope.PutCoords(m_pBufferPolygon.Envelope.XMin - 1, m_pBufferPolygon.Envelope.YMin - 1, _
m_pBufferPolygon.Envelope.XMax + 1, m_pBufferPolygon.Envelope.YMax + 1)
pEnvelope.Expand(1, 1, True)
pActiveView.Extent = pEnvelope
pActiveView.Refresh()
End Sub
Private Sub OnMouseDown(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long)
MsgBox("mousedown")
Dim pMxApp As IMxApplication
Dim pMxDoc As IMxDocument
Dim pMap As IMap
Dim pActiveView As IActiveView
Dim pEnvelope As IEnvelope
Dim pRubberEnv As IRubberBand
Dim MxStatusBar As IStatusBar
Dim pProgAnim As IAnimationProgressor
pRubberEnv = New RubberEnvelope
pMxApp = My.ArcMap.Application
pMxDoc = pMxApp.Document
pMap = pMxDoc.FocusMap
pActiveView = pMap
pProgAnim = MxStatusBar.ProgressAnimation
pEnvelope = pMxDoc.CurrentLocation.Envelope
pEnvelope.Expand(pMxDoc.SearchTolerance, pMxDoc.SearchTolerance, False)
'Refresh the old selection to erase it
pActiveView.PartialRefresh(esriViewDrawPhase.esriViewGeoSelection, Nothing, Nothing)
If shift = 1 Then
pMxApp.SelectionEnvironment.CombinationMethod = ESRI.ArcGIS.Carto.esriSelectionResultEnum.esriSelectionResultXOR
Else
pMxApp.SelectionEnvironment.CombinationMethod = ESRI.ArcGIS.Carto.esriSelectionResultEnum.esriSelectionResultNew
End If
'Play the progress animation
pProgAnim.Show()
pProgAnim.Play()
MxStatusBar.PlayProgressAnimation(True)
'Perform the selection using a point created on mouse down
pMap.SelectByShape(pEnvelope, pMxApp.SelectionEnvironment, True)
'Refresh again to draw the new selection
pActiveView.PartialRefresh(esriViewDrawPhase.esriViewGeoSelection, Nothing, Nothing)
End Sub
Protected Overrides Sub OnActivate()
MsgBox("OnActivate")
Dim pMap As IMap
Dim pActiveView As IActiveView
Dim pFeatureLayer As IFeatureLayer
Dim pGC As IGraphicsContainer
Dim pViewManager As IViewManager
Dim pRgbColor As IRgbColor
Dim MxStatusBar As IStatusBar
Dim pProgAnim As IAnimationProgressor
m_pMxDoc = My.ArcMap.Document
pMap = m_pMxDoc.FocusMap
pActiveView = m_pMxDoc.ActiveView
MxStatusBar = My.ArcMap.Application.StatusBar
pGC = pMap
pGC.DeleteAllElements()
pViewManager = m_pMxDoc.FocusMap
pViewManager.VerboseEvents = True
ActiveViewEvents = m_pMxDoc.FocusMap
'Play some progress animation
pProgAnim = MxStatusBar.ProgressAnimation
pProgAnim.Show()
pProgAnim.Play()
MxStatusBar.PlayProgressAnimation(True)
'Create the fill symbol
m_pFillSymbol = New SimpleFillSymbol
m_pOutlineSymbol = m_pFillSymbol.Outline
m_pFillSymbol.Style = ESRI.ArcGIS.Display.esriSimpleFillStyle.esriSFSHollow
'Create the outline symbol
m_pOutlineSymbol.Style = ESRI.ArcGIS.Display.esriSimpleLineStyle.esriSLSSolid
m_pOutlineSymbol.Width = 4
pRgbColor = New RgbColor
pRgbColor.Red = 197
pRgbColor.Green = 0
pRgbColor.Blue = 255
m_pOutlineSymbol.Color = pRgbColor
m_pFillSymbol.Outline = m_pOutlineSymbol
MsgBox("finished OnActivate")
End Sub
End Class
1 Reply
06-14-2012
12:07 PM
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
I revisited this and got it working as an add-in. The "Add Event Wiring for All IActiveViewEvents Snippet" was helpful.
Code:
'Draws 1/4 mile buffer on top most polygon layer.
Imports ESRI.ArcGIS.esriSystem
Imports ESRI.ArcGIS.ArcMapUI
Imports ESRI.ArcGIS.Carto
Imports ESRI.ArcGIS.Geometry
Imports ESRI.ArcGIS.Display
Imports ESRI.ArcGIS.Geodatabase
Imports ESRI.ArcGIS.ArcCatalog
Public Class NitrateBufferTool
Inherits ESRI.ArcGIS.Desktop.AddIns.Tool
Private m_pBufferPolygon As IPolygon
Private m_pLastBufferedExtent As IEnvelope
Private m_pFillSymbol As ISimpleFillSymbol
Private m_pOutlineSymbol As ISimpleLineSymbol
'Declare Event Handlers
Private m_ActiveViewEventsAfterItemDraw As ESRI.ArcGIS.Carto.IActiveViewEvents_AfterItemDrawEventHandler
Private m_ActiveViewEventsSelectionChanged As ESRI.ArcGIS.Carto.IActiveViewEvents_SelectionChangedEventHandler
Protected Overrides Sub OnUpdate()
Enabled = My.ArcMap.Application IsNot Nothing
End Sub
'Set up the event handlers for the IActiveViewEvents
Private Sub SetupActiveViewEvents(ByVal map As ESRI.ArcGIS.Carto.IMap)
If map Is Nothing Then
Return
End If
Dim activeViewEvents As ESRI.ArcGIS.Carto.IActiveViewEvents_Event = TryCast(map, ESRI.ArcGIS.Carto.IActiveViewEvents_Event)
'Create an instance of the delegate, add it to AfterItemDraw event
m_ActiveViewEventsAfterItemDraw = New ESRI.ArcGIS.Carto.IActiveViewEvents_AfterItemDrawEventHandler(AddressOf OnActiveViewEventsAfterItemDraw)
AddHandler activeViewEvents.AfterItemDraw, m_ActiveViewEventsAfterItemDraw
'Create an instance of the delegate, add it to SelectionChanged event
m_ActiveViewEventsSelectionChanged = New ESRI.ArcGIS.Carto.IActiveViewEvents_SelectionChangedEventHandler(AddressOf OnActiveViewEventsSelectionChanged)
AddHandler activeViewEvents.SelectionChanged, m_ActiveViewEventsSelectionChanged
End Sub
Protected Overrides Sub OnActivate()
MyBase.OnActivate()
Dim pMap As IMap
Dim m_pMxDoc As IMxDocument
Dim pActiveView As IActiveView
Dim pGC As IGraphicsContainer
Dim pViewManager As IViewManager
Dim pRgbColor As IRgbColor
Dim ActiveViewEvents As ISelectionEvents
m_pMxDoc = My.ArcMap.Document
pMap = m_pMxDoc.FocusMap
pActiveView = m_pMxDoc.ActiveView
pGC = pMap
pGC.DeleteAllElements()
pMap = Nothing
pGC = Nothing
pViewManager = m_pMxDoc.FocusMap
pViewManager.VerboseEvents = True
ActiveViewEvents = m_pMxDoc.FocusMap
'Create the fill symbol
m_pFillSymbol = New SimpleFillSymbol
m_pOutlineSymbol = m_pFillSymbol.Outline
m_pFillSymbol.Style = ESRI.ArcGIS.Display.esriSimpleFillStyle.esriSFSHollow
'Create the outline symbol
m_pOutlineSymbol.Style = ESRI.ArcGIS.Display.esriSimpleLineStyle.esriSLSSolid
m_pOutlineSymbol.Width = 4
pRgbColor = New RgbColor
pRgbColor.Red = 197
pRgbColor.Green = 0
pRgbColor.Blue = 255
m_pOutlineSymbol.Color = pRgbColor
m_pFillSymbol.Outline = m_pOutlineSymbol
End Sub
Protected Overrides Sub OnMouseDown(ByVal arg As ESRI.ArcGIS.Desktop.AddIns.Tool.MouseEventArgs)
MyBase.OnMouseDown(arg)
Dim pMxApp As IMxApplication
Dim pMxDoc As IMxDocument
Dim pMap As IMap
Dim pActiveView As IActiveView
Dim pEnvelope As IEnvelope
Dim pRubberEnv As IRubberBand
pRubberEnv = New RubberEnvelope
pMxApp = My.ArcMap.Application
pMxDoc = pMxApp.Document
pMap = pMxDoc.FocusMap
pActiveView = pMap
'Fire off the event listener
SetupActiveViewEvents(pMap)
pEnvelope = pMxDoc.CurrentLocation.Envelope
pEnvelope.Expand(pMxDoc.SearchTolerance, pMxDoc.SearchTolerance, False)
'Refresh the old selection to erase it
pActiveView.PartialRefresh(esriViewDrawPhase.esriViewGeoSelection, Nothing, Nothing)
If arg.ModifierKeys = (System.Windows.Forms.Keys.Shift) Then
pMxApp.SelectionEnvironment.CombinationMethod = ESRI.ArcGIS.Carto.esriSelectionResultEnum.esriSelectionResultXOR
Else
pMxApp.SelectionEnvironment.CombinationMethod = ESRI.ArcGIS.Carto.esriSelectionResultEnum.esriSelectionResultNew
End If
'Perform the selection using a point created on mouse down
pMap.SelectByShape(pEnvelope, pMxApp.SelectionEnvironment, True)
'Refresh again to draw the new selection
pActiveView.PartialRefresh(esriViewDrawPhase.esriViewGeoSelection, Nothing, Nothing)
End Sub
'AfterItemDraw Event handler
Private Sub OnActiveViewEventsAfterItemDraw(ByVal Index As Integer, ByVal display As ESRI.ArcGIS.Display.IDisplay, ByVal phase As ESRI.ArcGIS.Carto.esriViewDrawPhase)
'Only draw in the view geography phase
If Not phase = esriViewDrawPhase.esriViewGeography Then Exit Sub
'Draw the buffered polygon
If m_pBufferPolygon Is Nothing Then Exit Sub
With display
.SetSymbol(m_pFillSymbol)
.DrawPolygon(m_pBufferPolygon)
End With
End Sub
'SelectionChanged Event handler
Private Sub OnActiveViewEventsSelectionChanged()
Dim pMxApp As IMxApplication
Dim m_pMxDoc As IMxDocument
Dim pmap As IMap
Dim pActiveView As IActiveView
Dim pEnumFeature As IEnumFeature
Dim pFeature As IFeature
Dim pPolygon As IPolygon
Dim pTopoOperator As ITopologicalOperator
Dim pGeometryBag As IGeometryCollection
pMxApp = My.ArcMap.Application
m_pMxDoc = pMxApp.Document
pmap = m_pMxDoc.FocusMap
pActiveView = m_pMxDoc.FocusMap
pGeometryBag = New GeometryBag
'Flag last buffered region for invalidation
If Not m_pLastBufferedExtent Is Nothing Then
pActiveView.PartialRefresh(esriViewDrawPhase.esriViewGeography, Nothing, m_pLastBufferedExtent)
End If
If m_pMxDoc.FocusMap.SelectionCount = 0 Then
'Nothing selected; don't draw anything; bail
m_pBufferPolygon = Nothing
Exit Sub
End If
'Buffer each selected feature
pEnumFeature = m_pMxDoc.FocusMap.FeatureSelection
pEnumFeature.Reset()
pFeature = pEnumFeature.Next
Do While Not pFeature Is Nothing
pTopoOperator = pFeature.Shape
pPolygon = pTopoOperator.Buffer(1320)
pGeometryBag.AddGeometry(pPolygon)
'Get next feature
pFeature = pEnumFeature.Next
Loop
'Union all the buffers into one polygon
m_pBufferPolygon = New Polygon
pTopoOperator = m_pBufferPolygon 'QI
pTopoOperator.ConstructUnion(pGeometryBag)
m_pLastBufferedExtent = m_pBufferPolygon.Envelope
'Flag new buffered region for invalidation
pActiveView.PartialRefresh(esriViewDrawPhase.esriViewGeography, Nothing, m_pBufferPolygon.Envelope)
'Zoom to the buffer extent
Dim pEnvelope As IEnvelope
pEnvelope = New Envelope
pEnvelope.PutCoords(m_pBufferPolygon.Envelope.XMin - 1, m_pBufferPolygon.Envelope.YMin - 1, _
m_pBufferPolygon.Envelope.XMax + 1, m_pBufferPolygon.Envelope.YMax + 1)
pEnvelope.Expand(1, 1, True)
pActiveView.Extent = pEnvelope
pActiveView.Refresh()
End Sub
End Class
Code:
'Draws 1/4 mile buffer on top most polygon layer.
Imports ESRI.ArcGIS.esriSystem
Imports ESRI.ArcGIS.ArcMapUI
Imports ESRI.ArcGIS.Carto
Imports ESRI.ArcGIS.Geometry
Imports ESRI.ArcGIS.Display
Imports ESRI.ArcGIS.Geodatabase
Imports ESRI.ArcGIS.ArcCatalog
Public Class NitrateBufferTool
Inherits ESRI.ArcGIS.Desktop.AddIns.Tool
Private m_pBufferPolygon As IPolygon
Private m_pLastBufferedExtent As IEnvelope
Private m_pFillSymbol As ISimpleFillSymbol
Private m_pOutlineSymbol As ISimpleLineSymbol
'Declare Event Handlers
Private m_ActiveViewEventsAfterItemDraw As ESRI.ArcGIS.Carto.IActiveViewEvents_AfterItemDrawEventHandler
Private m_ActiveViewEventsSelectionChanged As ESRI.ArcGIS.Carto.IActiveViewEvents_SelectionChangedEventHandler
Protected Overrides Sub OnUpdate()
Enabled = My.ArcMap.Application IsNot Nothing
End Sub
'Set up the event handlers for the IActiveViewEvents
Private Sub SetupActiveViewEvents(ByVal map As ESRI.ArcGIS.Carto.IMap)
If map Is Nothing Then
Return
End If
Dim activeViewEvents As ESRI.ArcGIS.Carto.IActiveViewEvents_Event = TryCast(map, ESRI.ArcGIS.Carto.IActiveViewEvents_Event)
'Create an instance of the delegate, add it to AfterItemDraw event
m_ActiveViewEventsAfterItemDraw = New ESRI.ArcGIS.Carto.IActiveViewEvents_AfterItemDrawEventHandler(AddressOf OnActiveViewEventsAfterItemDraw)
AddHandler activeViewEvents.AfterItemDraw, m_ActiveViewEventsAfterItemDraw
'Create an instance of the delegate, add it to SelectionChanged event
m_ActiveViewEventsSelectionChanged = New ESRI.ArcGIS.Carto.IActiveViewEvents_SelectionChangedEventHandler(AddressOf OnActiveViewEventsSelectionChanged)
AddHandler activeViewEvents.SelectionChanged, m_ActiveViewEventsSelectionChanged
End Sub
Protected Overrides Sub OnActivate()
MyBase.OnActivate()
Dim pMap As IMap
Dim m_pMxDoc As IMxDocument
Dim pActiveView As IActiveView
Dim pGC As IGraphicsContainer
Dim pViewManager As IViewManager
Dim pRgbColor As IRgbColor
Dim ActiveViewEvents As ISelectionEvents
m_pMxDoc = My.ArcMap.Document
pMap = m_pMxDoc.FocusMap
pActiveView = m_pMxDoc.ActiveView
pGC = pMap
pGC.DeleteAllElements()
pMap = Nothing
pGC = Nothing
pViewManager = m_pMxDoc.FocusMap
pViewManager.VerboseEvents = True
ActiveViewEvents = m_pMxDoc.FocusMap
'Create the fill symbol
m_pFillSymbol = New SimpleFillSymbol
m_pOutlineSymbol = m_pFillSymbol.Outline
m_pFillSymbol.Style = ESRI.ArcGIS.Display.esriSimpleFillStyle.esriSFSHollow
'Create the outline symbol
m_pOutlineSymbol.Style = ESRI.ArcGIS.Display.esriSimpleLineStyle.esriSLSSolid
m_pOutlineSymbol.Width = 4
pRgbColor = New RgbColor
pRgbColor.Red = 197
pRgbColor.Green = 0
pRgbColor.Blue = 255
m_pOutlineSymbol.Color = pRgbColor
m_pFillSymbol.Outline = m_pOutlineSymbol
End Sub
Protected Overrides Sub OnMouseDown(ByVal arg As ESRI.ArcGIS.Desktop.AddIns.Tool.MouseEventArgs)
MyBase.OnMouseDown(arg)
Dim pMxApp As IMxApplication
Dim pMxDoc As IMxDocument
Dim pMap As IMap
Dim pActiveView As IActiveView
Dim pEnvelope As IEnvelope
Dim pRubberEnv As IRubberBand
pRubberEnv = New RubberEnvelope
pMxApp = My.ArcMap.Application
pMxDoc = pMxApp.Document
pMap = pMxDoc.FocusMap
pActiveView = pMap
'Fire off the event listener
SetupActiveViewEvents(pMap)
pEnvelope = pMxDoc.CurrentLocation.Envelope
pEnvelope.Expand(pMxDoc.SearchTolerance, pMxDoc.SearchTolerance, False)
'Refresh the old selection to erase it
pActiveView.PartialRefresh(esriViewDrawPhase.esriViewGeoSelection, Nothing, Nothing)
If arg.ModifierKeys = (System.Windows.Forms.Keys.Shift) Then
pMxApp.SelectionEnvironment.CombinationMethod = ESRI.ArcGIS.Carto.esriSelectionResultEnum.esriSelectionResultXOR
Else
pMxApp.SelectionEnvironment.CombinationMethod = ESRI.ArcGIS.Carto.esriSelectionResultEnum.esriSelectionResultNew
End If
'Perform the selection using a point created on mouse down
pMap.SelectByShape(pEnvelope, pMxApp.SelectionEnvironment, True)
'Refresh again to draw the new selection
pActiveView.PartialRefresh(esriViewDrawPhase.esriViewGeoSelection, Nothing, Nothing)
End Sub
'AfterItemDraw Event handler
Private Sub OnActiveViewEventsAfterItemDraw(ByVal Index As Integer, ByVal display As ESRI.ArcGIS.Display.IDisplay, ByVal phase As ESRI.ArcGIS.Carto.esriViewDrawPhase)
'Only draw in the view geography phase
If Not phase = esriViewDrawPhase.esriViewGeography Then Exit Sub
'Draw the buffered polygon
If m_pBufferPolygon Is Nothing Then Exit Sub
With display
.SetSymbol(m_pFillSymbol)
.DrawPolygon(m_pBufferPolygon)
End With
End Sub
'SelectionChanged Event handler
Private Sub OnActiveViewEventsSelectionChanged()
Dim pMxApp As IMxApplication
Dim m_pMxDoc As IMxDocument
Dim pmap As IMap
Dim pActiveView As IActiveView
Dim pEnumFeature As IEnumFeature
Dim pFeature As IFeature
Dim pPolygon As IPolygon
Dim pTopoOperator As ITopologicalOperator
Dim pGeometryBag As IGeometryCollection
pMxApp = My.ArcMap.Application
m_pMxDoc = pMxApp.Document
pmap = m_pMxDoc.FocusMap
pActiveView = m_pMxDoc.FocusMap
pGeometryBag = New GeometryBag
'Flag last buffered region for invalidation
If Not m_pLastBufferedExtent Is Nothing Then
pActiveView.PartialRefresh(esriViewDrawPhase.esriViewGeography, Nothing, m_pLastBufferedExtent)
End If
If m_pMxDoc.FocusMap.SelectionCount = 0 Then
'Nothing selected; don't draw anything; bail
m_pBufferPolygon = Nothing
Exit Sub
End If
'Buffer each selected feature
pEnumFeature = m_pMxDoc.FocusMap.FeatureSelection
pEnumFeature.Reset()
pFeature = pEnumFeature.Next
Do While Not pFeature Is Nothing
pTopoOperator = pFeature.Shape
pPolygon = pTopoOperator.Buffer(1320)
pGeometryBag.AddGeometry(pPolygon)
'Get next feature
pFeature = pEnumFeature.Next
Loop
'Union all the buffers into one polygon
m_pBufferPolygon = New Polygon
pTopoOperator = m_pBufferPolygon 'QI
pTopoOperator.ConstructUnion(pGeometryBag)
m_pLastBufferedExtent = m_pBufferPolygon.Envelope
'Flag new buffered region for invalidation
pActiveView.PartialRefresh(esriViewDrawPhase.esriViewGeography, Nothing, m_pBufferPolygon.Envelope)
'Zoom to the buffer extent
Dim pEnvelope As IEnvelope
pEnvelope = New Envelope
pEnvelope.PutCoords(m_pBufferPolygon.Envelope.XMin - 1, m_pBufferPolygon.Envelope.YMin - 1, _
m_pBufferPolygon.Envelope.XMax + 1, m_pBufferPolygon.Envelope.YMax + 1)
pEnvelope.Expand(1, 1, True)
pActiveView.Extent = pEnvelope
pActiveView.Refresh()
End Sub
End Class
