Hatch all features in a layer

Created:9/09/2002
Description:

Hatching is a type of labeling designed to post and label hatches along measured linear features. Hatching can be applied to features with distance-based measures or non-distance based measures. Distance based measures include kilometers, miles, feet and meters. Non-distance based measures include seismic shot point numbers, where measure values generally increase in even intervals based upon some nominal distance. A hatch can be represented by a line symbol or a marker symbol. Each hatch may or may not be labeled.

The following code sample will create the simple hatching pattern seen in the figure below. It is possible to create much more complex hatching patterns than this.



How to use:
  1. Add a polyline (with measures) layer to your map.
  2. Paste the code into VB or VBA.
  3. Modify the code to match your data, etc .
  4. Run the code.
  5. Save the map document.
  6. Close ArcMap.
  7. Open the saved map document. Notice that the hatches have been persisted with the layer.
Public Sub Hatches()
  
  '+++ Get the polyine (with measures) layer and its hatch layer extension.
  Dim pMxDoc As IMxDocument
  Dim pMap As IMap
  Dim pLayerExt As ILayerExtensions
  Dim pLayer As ILayer
  Dim pFLayer As IFeatureLayer
  Dim i As Long
  
  Set pMxDoc = Application.Document
  Set pMap = pMxDoc.FocusMap
  For i = 0 To pMap.LayerCount - 1
    Set pLayer = pMap.Layer(i)
    If pLayer.Name = "Hatches" Then  'Assume the layer name is "hatches" 
      If TypeOf pLayer Is IFeatureLayer Then
        Set pFLayer = pLayer
        Exit For
      End If
    End If
  Next i
  If pFLayer Is Nothing Then
    MsgBox "Could not find the polyline feature with measure (Ms) layer.", vbExclamation, ""
    Exit Sub
  End If
  
  
  '+++ Some symbology to be used later.
  Dim pLineSymbol As ILineSymbol
  Dim pTextSymbol As ITextSymbol
  Dim pColor As IColor
  Set pLineSymbol = New SimpleLineSymbol
  Set pTextSymbol = New TextSymbol
  pTextSymbol.Size = 8
  Set pColor = New RgbColor
  pColor.RGB = RGB(255, 25, 15)
  pTextSymbol.Color = pColor
  pTextSymbol.HorizontalAlignment = esriTHALeft
  pTextSymbol.VerticalAlignment = esriTVACenter
  
  
  '+++ Get the hatch layer extension that is automatically attached to the layer by ArcMap.
  Dim pHatchLayerExt As IHatchLayerExtension
  Set pLayerExt = pFLayer
  For i = 0 To pLayerExt.ExtensionCount - 1
    If TypeOf pLayerExt.Extension(i) Is IHatchLayerExtension Then
      Set pHatchLayerExt = pLayerExt.Extension(i)
      Exit For
    End If
  Next i
  If pHatchLayerExt Is Nothing Then
    MsgBox "Could not find hatch layer extension", vbExclamation
    Exit Sub
  End If

  
  '+++ The hatch layer extension always maintains a 'default' hatch class. The following code
  '+++ simply gets rid of any existing hatch classes. 
  pHatchLayerExt.RemoveAll

  
  '+++ The following code will place a hatch every 0.25 miles. Every fourth hatch
  '+++ will be labeled. Lastly, each line will have special hatches at their ends.
  
  '+++ To do this, we must create a hatch class. A hatch class has a hatch template.
  '+++ Each hatch template is composed of one or more hatch definitions. A hatch definition
  '+++ may or may not be labeled. To place hatches at the ends of a line, you use an end hatch
  '+++ definition. A hatch template can only have one end hatch definition.
  
  '+++ A layer can have more than one hatch class attached to it. This is
  '+++ useful when you want to hatch different features in different ways or
  '+++ if you want to hatch features differently, depending on the map's scale. 
  '+++ Create a hatch class and indicate its interval. We will assign a template to it later.
  Dim pHatchClass As IHatchClass
  Set pHatchClass = New HatchClass
  
  
  '+++ Set the hatch interval for the hatch class.
  Dim pHatchInput As IHatchInputValue
  Set pHatchInput = New HatchInputValue
  pHatchInput.Value = 0.25
  Set pHatchClass.HatchInterval = pHatchInput

  
  '+++ Create a hatch template. We will assign the definitions to it later.
  Dim pHatchTemplate As IHatchTemplate
  Set pHatchTemplate = New HatchTemplate
  
  
  'Create the first hatch definition. It will not have labels. 
  Dim pHatchDef1 As IHatchDefinition
  Dim pHatchLineDef1 As IHatchLineDefinition  'or IHatchMarkerDefinition.
  Set pHatchDef1 = New HatchLineDefinition  'or HatchMarkerDefinition.
  Set pHatchDef1.HatchSymbol = pLineSymbol
  Set pHatchLineDef1 = pHatchDef1
  pHatchLineDef1.Length = 500  'specified in the xy units of the feature class's spatial reference.


  '+++ Create the second hatch definition (with labels).
  Dim pHatchDef2 As IHatchDefinition
  Dim pHatchLineDef12 As IHatchLineDefinition
  Set pHatchDef2 = New HatchLineDefinition
  With pHatchDef2
    Set .HatchSymbol = pLineSymbol
    .TextDisplay = esriHatchTDValueOnly
    Set .TextSymbol = pTextSymbol
    .DisplayPrecision = 1
  End With
  Set pHatchLineDef12 = pHatchDef2
  pHatchLineDef12.Length = pHatchLineDef1.Length * 1.5
  
  
  '+++ Create end hatches (with labels). We will copy the properties from the second hatch def.
  Dim pClone As IClone
  Dim pEndsHatchDef As IHatchDefinition
  Set pClone = pHatchDef2
  Set pEndsHatchDef = pClone.Clone

  
  '+++ Add the hatch definitions to the hatch template.
  With pHatchTemplate
    .Name = "HatchTemplate1"
    .AddHatchDefinition 1, pHatchDef1
    .AddHatchDefinition 4, pHatchDef2
    Set .EndHatchDefinition = pEndsHatchDef
    .EndHatchDrawingTolerance = 0.2 'No hatch will be placed if it is within 0.2 measure units of the end.
    .StartAtIntervalMultiple = True
  End With

  
  '+++ Apply the template to the hatch class. Even though they are not done here, you can also do the
  '+++ following with a hatch class:
  '+++      - specify a query filter to limit the features that are hatched
  '+++      - specify start and finish values to limit the portions of features that are hatched
  '+++      - specify a minimum and maximum scale at which hatches will be displayed
  '+++      - offset all of the hatch definitions in the hatch class (this is different than offsetting
  '+++        the individual hatch definitions.  
   Set pHatchClass.HatchTemplate = pHatchTemplate

  
  '+++ Add the hatch class to the hatch layer extension. 
  pHatchLayerExt.AddClass "Class1", pHatchClass
  pHatchLayerExt.ShowHatches = True 'Show the hatch class(es)
  '+++ Refresh the map document. 
  pMxDoc.ActiveView.Refresh

End Sub