Transform line events

Created:9/6/2002
Description:

This code demonstrates how to transform line events from one route reference to another. The new event table can be added to ArcMap as a layer using dynamic segmentation.

Note: This sample code is similar to the 'Locate line features along routes' sample. That is, you can also use the LocateLineFeatures method demonstrated below to overlay lines onto routes.


How to use:
  1. Paste the code into VB/VBA.
  2. Change the code to point to your data
  3. Run the code.
Public Sub TransformLineEvents()
  On Error GoTo eh
  
  '+++ Get the input line event table and route feature class.
  Dim pWS As IWorkspace
  Dim pWSF As IWorkspaceFactory
  Dim pFWS As IFeatureWorkspace
  Dim pInRouteFC As IFeatureClass
  Dim pEventTable As ITable
  
  Set pWSF = New AccessWorkspaceFactory
  Set pWS = pWSF.OpenFromFile("\\burt\data\nysdot2\nysdot.mdb", 0)
  Set pFWS = pWS
  Set pInRouteFC = pFWS.OpenFeatureClass("RefmkrRoute")
  Set pEventTable = pFWS.OpenTable("HighAccidentLocations")
  
  '+++ Create a RouteEventSource object for the line events. A RouteEventSource is a
  '+++ 'dynamic' feature class and can be used anywhere a regular feature class can be used.
  Dim pName As IName
  Dim pDS As IDataset
  Dim pRMLName As IRouteLocatorName
  
  Set pDS = pInRouteFC
  Set pName = pDS.FullName
  Set pRMLName = New RouteMeasureLocatorName
  With pRMLName
    Set .RouteFeatureClassName = pName
    .RouteIDFieldName = "ROUTE"
  End With
 
  Dim pRtProp As IRouteEventProperties2
  Dim pRMLnProp As IRouteMeasureLineProperties
  Dim pRESN As IRouteEventSourceName
  Dim pRES As IRouteEventSource
  
  Set pRtProp = New RouteMeasureLineProperties
  pRtProp.EventRouteIDFieldName = "ROUTE_GIS"
  Set pRMLnProp = pRtProp
  pRMLnProp.FromMeasureFieldName = "FROM_RM"
  pRMLnProp.ToMeasureFieldName = "TO_RM"
    
  Set pDS = pEventTable
  Set pName = pDS.FullName
  Set pRESN = New RouteEventSourceName
  With pRESN
    Set .EventTableName = pName
    Set .EventProperties = pRMLnProp
    Set .RouteLocatorName = pRMLName
  End With
  Set pName = pRESN
  Set pRES = pName.Open
  
  '+++ Get the target route feature class. This is the feature class we will be
  '+++ transforming the events to. We'll assume this feature class is in the same workspace
  '+++ as the rest of out inputs. 
  Dim pTargetRouteFC As IFeatureClass
  Set pTargetRouteFC = pFWS.OpenFeatureClass("MileptRoute")
  
  '+++ Create a route locator for the target route feature class
  Dim pTargetRtLocName As IRouteLocatorName
  Dim pTargetRtLoc As IRouteLocator
  Set pDS = pTargetRouteFC
  Set pName = pDS.FullName
  Set pTargetRtLocName = New RouteMeasureLocatorName
  With pTargetRtLocName
    Set .RouteFeatureClassName = pName
    .RouteIDFieldName = "ROUTE"
  End With
  Set pName = pTargetRtLocName
  Set pTargetRtLoc = pName.Open
  
  '+++ Create an output table name object. We'll write to the same workspace as the
  '+++ input routes and lines
  Dim pOutDSN As IDatasetName
  Dim pOutWSN As IWorkspaceName
  Set pDS = pWS
  Set pOutWSN = pDS.FullName
  Set pOutDSN = New TableName
  Set pOutDSN.WorkspaceName = pOutWSN
  pOutDSN.Name = "TransformLine_Output"    'this table should not exist already

  '+++ Create a RouteLocatorOperations object. 
  Dim pRouteLocOps As IRouteLocatorOperations
  Set pRouteLocOps = New RouteLocatorOperations
  With pRouteLocOps
    Set .RouteLocator = pTargetRtLoc
    Set .InputFeatureClass = pRES
  End With
  
  '+++ Set event properties for the output line event table. The field names specified will be written to the
  '+++ output table.
  Dim pEventProps As IRouteEventProperties
  Dim pRMlineProps As IRouteMeasureLineProperties
  Set pEventProps = New RouteMeasureLineProperties
  pEventProps.EventRouteIDFieldName = "ROUTE"
  Set pRMlineProps = pEventProps
  pRMlineProps.FromMeasureFieldName = "FROM_MP"
  pRMlineProps.ToMeasureFieldName = "TO_MP"
  
  '+++ Locate the lines along the routes
  Dim pOutTable As ITable
  Dim dClusterTol As Double
  Dim bKeepAllFields As Boolean
  dClusterTol = 0.01   'specified in the units of the route feature class's coordinate system
  bKeepAllFields = True 'keep all of the input line feature class's attributes
  Set pOutTable = pRouteLocOps.LocateLineFeatures(dClusterTol, pEventProps, bKeepAllFields, pOutDSN, "", Nothing)

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