You are here: > ESRI Forums > arcgis desktop discussion forums > Thread Replies

ArcGIS Desktop Discussion Forums

ArcGIS Desktop - ArcObjects General forum

Labels for each segment of a line   Pierre Vos Aug 12, 2003
Re: Labels for each segment of a line   Olivier Damanet Aug 12, 2003
Report Inappropriate Content • Top • Print • This Forum is closed for replies.    
Subject Labels for each segment of a line 
Author Pierre Vos 
Date Aug 12, 2003 
Message Hi,

I would like to create feature linked annotations for polyline layer. The difficulty is that I need to annotate the length of each segment composing the polyline. I other words, if I have a polyline with 5 vertices, I thus have 4 segments so I must create 4 differents labels.

Any suggestion is welcome.




 
  Pierre VOS 
   
Report Inappropriate Content • Top • Print • This Forum is closed for replies.    
Subject Re: Labels for each segment of a line 
Author Olivier Damanet 
Date Aug 12, 2003 
Message Here is a solution using text elements.
It creates a new Annotation Group (see Data Frame Properties / Annotation Groups Tab), which is linked to the source feature layer (so the labels are not displayed if the layer is turned of).
It uses the spatial reference of the source layer to measure the segments, and to put the labels on the map, whatever the spatial reference of the dataframe. 
 
Option Explicit

Sub LabelLengthSegments()
  Dim pMxDoc As IMxDocument
  Set pMxDoc = ThisDocument
  Dim pFeatureLayer As IFeatureLayer
  Set pFeatureLayer = pMxDoc.FocusMap.Layer(0)
  
'+++ Create a new Graphics Layer to display the labels
  Dim pCompositeGraphicLayer As ICompositeGraphicsLayer
  Set pCompositeGraphicLayer = pMxDoc.FocusMap.BasicGraphicsLayer
  Dim pGeoDatasetSchemaEdit As IGeoDatasetSchemaEdit
  Set pGeoDatasetSchemaEdit = pCompositeGraphicLayer
  'set the graphic layer to the same spatial reference as source layer
  Dim pGeoDataset As IGeoDataset
  Set pGeoDataset = pFeatureLayer.FeatureClass
  Dim pSpatialReference As ISpatialReference
  Set pSpatialReference = pGeoDataset.SpatialReference
  If TypeOf pSpatialReference Is IUnknownCoordinateSystem Then
    MsgBox "No spatial reference defined for this layer" & vbCrLf & "Could not label segment lengths"
    Exit Sub
  End If
  pGeoDatasetSchemaEdit.AlterSpatialReference pSpatialReference
  'create or get existing graphic layer
  Dim pGraphicLayer As IGraphicsLayer
  Dim pGraphicContainer As IGraphicsContainer
  On Error Resume Next 'force the creation of the new graphic layer
  If pCompositeGraphicLayer.FindLayer(pFeatureLayer.Name & " Label") Is Nothing Then
  On Error GoTo EH
    Set pGraphicLayer = pCompositeGraphicLayer.AddLayer(pFeatureLayer.Name & " Label", Nothing)
    Set pGraphicLayer.AssociatedLayer = pFeatureLayer
    Set pGraphicContainer = pGraphicLayer
  Else
    Set pGraphicLayer = pCompositeGraphicLayer.FindLayer(pFeatureLayer.Name & " Label")
    Set pGraphicContainer = pGraphicLayer
    pGraphicContainer.DeleteAllElements
  End If
  
  
'+++ Define the Text Symbol
  Dim pTextSymbolEditor As ITextSymbolEditor
  Set pTextSymbolEditor = New TextSymbolEditor
  Dim pTextSymbol As ITextSymbol
  Set pTextSymbol = New TextSymbol
  pTextSymbol.Text = "125.12"
  pTextSymbolEditor.ShowUnits = True
  pTextSymbolEditor.Title = "Define the symbol you want to use"
  pTextSymbolEditor.EditTextSymbol pTextSymbol, Application.hWnd
  
'+++ Create the label suffix from the Spatial Reference
  Dim sUnit As String
  If TypeOf pSpatialReference Is IProjectedCoordinateSystem Then
    Dim pProjectedCoordSys As IProjectedCoordinateSystem
    Set pProjectedCoordSys = pSpatialReference
    sUnit = pProjectedCoordSys.CoordinateUnit.Name
  Else
    sUnit = pMxDoc.FocusMap.MapUnits
  End If
        
'+++ Loop through the features
  Dim pFeatureCursor As IFeatureCursor
  Set pFeatureCursor = pFeatureLayer.Search(Nothing, False)
  Dim pFeature As IFeature
  Set pFeature = pFeatureCursor.NextFeature
  Do While Not pFeature Is Nothing
    'get the segments
    If Not TypeOf pFeature.ShapeCopy Is ISegmentCollection Then Exit Sub
    Dim pSegmentCollection As ISegmentCollection
    Set pSegmentCollection = pFeature.ShapeCopy
    Dim pEnumSegment As IEnumSegment
    Set pEnumSegment = pSegmentCollection.EnumSegments
    pEnumSegment.Reset
    Dim pSegment As ISegment
    Dim lPartIx As Long, lSegIx As Long
    pEnumSegment.Next pSegment, lPartIx, lSegIx
    Do While Not pSegment Is Nothing
      'create a text element for each one
      Dim pPoint As IPoint
      Set pPoint = New esriCore.Point
      pSegment.QueryPoint esriNoExtension, 0.5, True, pPoint
      Dim pElement As IElement
      Set pElement = CreateTextElement(Format(pSegment.Length, "#.##") & sUnit, pPoint, pTextSymbol)
      'rotate the element
      Dim pTransform2D As ITransform2D
      Set pTransform2D = pElement
      If TypeOf pSegment Is ILine Then
        Dim pLine As ILine
        Set pLine = pSegment
        pTransform2D.Rotate pPoint, pLine.Angle
      Else
        'For non linear segment (circular arc, etc.), you should try to get
        'the angle of the tangent at the center
        'of the arc to define the angle for the label
        'NOT IMPLEMENTED
      End If
      pGraphicContainer.AddElement pElement, 0
      pEnumSegment.Next pSegment, lPartIx, lSegIx
    Loop
    Set pFeature = pFeatureCursor.NextFeature
  Loop
  
'+++ Refresh
  pMxDoc.ActiveView.PartialRefresh esriViewGraphics, Nothing, Nothing
  Exit Sub
EH:
  MsgBox "failed to label segments " & Err.Description
End Sub

Private Function CreateTextElement(sText As String, pPosition As IPoint, Optional pSymbol As ITextSymbol = Nothing) As ITextElement
  Dim pTextElement As ITextElement
  Set pTextElement = New TextElement
  Dim pElement As IElement
  Set pElement = pTextElement
  
  pTextElement.Text = sText
  If Not pTextElement Is Nothing Then pTextElement.Symbol = pSymbol
  pElement.Geometry = pPosition

  Set CreateTextElement = pTextElement
End Function
 
  Olivier.