Add a point event layer to ArcMap

Created:8/28/2000
Description:

This VBA code demonstrates how to create a RouteEventSource object, which is a 'Dynamic' feature class. This feature class is then added to ArcMap as a layer.

How to use:
  1. Add a route (PolyLineM) layer to ArcMap called 'roads_route_hwy' (or change the code accordingly).
  2. Add a table called 'accident' to ArcMap (or change the code accordingly).
  3. Change the code to fit your data.
  4. Paste the code into VBA.
  5. Run the code.
Public Sub AddPointEventLayer()
  
  '+++ VBA code that shows how to add a point RouteEventSource as a layer in the Map
  
  On Error GoTo eh
  
  '+++ Get the event table. It is called 'accident'.
  Dim pMxDoc As IMxDocument
  Dim pTblColl As ITableCollection
  Dim pEventTable As ITable
  Dim i As Long
  Dim pMap As IMap
  Dim pDS As IDataset
  
  Set pMxDoc = ThisDocument
  Set pMap = pMxDoc.FocusMap
  Set pTblColl = pMap
  For i = 0 To pTblColl.TableCount - 1
    Set pDS = pTblColl.Table(i)
    If LCase(pDS.BrowseName) = "accident" Then
      Set pEventTable = pDS
      Exit For
    End If
  Next i
  If pEventTable Is Nothing Then
    MsgBox "Could not find event table", vbExclamation, "AddPointEventLayer"
    Exit Sub
  End If
  
  '+++ Get the route feature class. It is called 'roads_route_hwy'.
  Dim pLayer As ILayer
  Dim pFLayer As IFeatureLayer
  Dim pRouteFc As IFeatureClass
  For i = 0 To pMap.LayerCount - 1
    Set pLayer = pMap.Layer(i)
    If LCase(pLayer.Name) = "roads_route_hwy" Then
        If TypeOf pLayer Is IFeatureLayer Then
          Set pFLayer = pLayer
          Set pRouteFc = pFLayer.FeatureClass
          Exit For
        End If
    End If
  Next i
  If pRouteFc Is Nothing Then
    MsgBox "Could not find the route feature class", vbExclamation, "AddPointEventLayer"
    Exit Sub
  End If
  
  
  '+++ Create the route event source ...
  
  '+++ The route locator
  Dim pName As IName
  Dim pRMLName As IRouteLocatorName
  Set pDS = pRouteFc
  Set pName = pDS.FullName
  Set pRMLName = New RouteMeasureLocatorName
  With pRMLName
    Set .RouteFeatureClassName = pName
    .RouteIDFieldName = "rkey"
    .RouteIDIsUnique = True
    .RouteMeasureUnit = esriMeters
    '.RouteWhereClause = "" '+++ used to limit the number of routes
  End With

  '+++ Create the route event properties
  Dim pRtProp As IRouteEventProperties2
  Dim pRMPtProp As IRouteMeasurePointProperties2
  Set pRtProp = New RouteMeasurePointProperties
  With pRtProp
    .EventMeasureUnit = esriUnknownUnits
    .EventRouteIDFieldName = "rkey"
    '.LateralOffsetFieldName = "offset"
    .AddErrorField = True             'add field for locating errors
    .ErrorFieldName = "LOC_ERROR"     'specify name for the locating errors field
  End With
  '+++ IRouteMeasurePointProperties2 is used to include an angle field to the route event source.
  '+++ The angle field can be used to cartagrophical rotate point event symbology.
  Set pRMPtProp = pRtProp
  With pRMPtProp
    .MeasureFieldName = "mile"
    .AddAngleField = True
    .AngleFieldName = "LOC_ANGLE"
    .AsPointFeature = True        'point events shape will be of type Point. Multipoint if False
    .NormalAngle = True           'the angle normal to the digitize direction.  Will be tangent if False
    .ComplementAngle = False
  End With

     
  Set pDS = pEventTable
  Set pName = pDS.FullName
  Dim pRESN As IRouteEventSourceName
  Set pRESN = New RouteEventSourceName
  With pRESN
    Set .EventTableName = pName
    Set .EventProperties = pRMPtProp
    Set .RouteLocatorName = pRMLName
  End With

  
  '+++ By opening a route event source name object, you have a 'dynamic'
  '+++ feature class ...
  Dim pEventFC As IFeatureClass
  Set pName = pRESN
  Set pEventFC = pName.Open
  
  '+++ Create the layer and add it to the current map
  Dim pActive As IActiveView
  Set pFLayer = New FeatureLayer
  Set pFLayer.FeatureClass = pEventFC
  pFLayer.Name = pDS.BrowseName + "_Events"  '+++ "Accident_Events"
  pMap.AddLayer pFLayer

  
  Set pActive = pMxDoc.ActiveView
  pActive.Refresh
  
  Exit Sub

 eh:
  Dim lNum As Long, sDesc As String, sSrc As String
  lNum = Err.Number
  sDesc = Err.Description
  sSrc = Err.Source
  Err.Raise lNum, sSrc, sDesc
End Sub