How to draw rectangles

Use this subroutine to draw a Rectangle on the screen. With this example the rectangle will not persist on the screen; it will disappear when the screen next refreshes. See How to draw polygon buffers for an example showing how drawings can be persisted on the display.

How to use

  1. Add a new UITool control onto any toolbar.
  2. Paste the code below into its OnMouseDown event.
  3. Mind the name of the control, the sample assumes it is called UIToolControl1.
  4. Completely close down VBA so mouse events will fire.
  5. Select this tool, drag a rectangle on the map.
[VBA] 
Private Sub UIToolControl1_MouseDown(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long)
    Dim pMxDoc As IMxDocument
    Dim pActiveView As IActiveView
    Dim pScreenDisplay As IScreenDisplay
    Dim pRubberEnv As IRubberBand
    Dim pFillSymbol As ISimpleFillSymbol
    Dim pRgbColor As IRgbColor
    Dim pEnvelope As IEnvelope
    
    Set pMxDoc = Application.Document
    Set pActiveView = pMxDoc.FocusMap
    Set pScreenDisplay = pActiveView.ScreenDisplay
    Set pRubberEnv = New RubberEnvelope
    
    Set pFillSymbol = New SimpleFillSymbol
    Set pRgbColor = New RgbColor
    pRgbColor.Red = 255
    pFillSymbol.Color = pRgbColor
    
    Set pEnvelope = pRubberEnv.TrackNew(pScreenDisplay, pFillSymbol)
    
    With pScreenDisplay
        .StartDrawing pScreenDisplay.hdc, esriNoScreenCache
        .SetSymbol pFillSymbol
        .DrawRectangle pEnvelope
        .FinishDrawing
    End With
End Sub