Le portail francophone de la géomatique

Dim pSC As ISegmentCollection
            Dim pEnumFeature As IEnumFeature
            Dim pMap As IMap
            Dim pMxDoc As IMxDocument
            Dim pFeature As IFeature
            Dim pPolygon As IPolygon
            Dim pEnumSegment As IEnumSegment
            Dim pSegment As ISegment
            Dim pPoint As IPoint
            Dim pFLayer As IFeatureLayer
            Dim pPointFClass As IFeatureClass
            Dim pNewFeature As IFeature
            Dim outPartIndex As Integer
            Dim segmentIndex As Integer
            Dim pLELProps As ILabelEngineLayerProperties
            Dim pAnnoLyrProps As IAnnotateLayerProperties
            Dim pGeoFLayer As IGeoFeatureLayer

            pMxDoc = m_pMxDoc
            pMap = pMxDoc.FocusMap
            pEnumFeature = pMap.FeatureSelection
            pFeature = pEnumFeature.Next
            Do Until pFeature Is Nothing
                pPolygon = TryCast(pFeature.Shape, IPolygon)
                If pPolygon IsNot Nothing Then
                    pSC = pPolygon

                    pFLayer = pMxDoc.SelectedLayer
                    pPointFClass = pFLayer.FeatureClass

                    pEnumSegment = pSC.EnumSegments
                    pEnumSegment.Next(pSegment, outPartIndex, segmentIndex)
                    Do Until pSegment Is Nothing
                        pPoint = New Point
                        pSegment.QueryPoint(esriSegmentExtension.esriNoExtension, 0.5, True, pPoint)

                        pNewFeature = pPointFClass.CreateFeature
                        pNewFeature.Value(pPointFClass.FindField("Length")) = pSegment.Length
                        pNewFeature.Shape = pPoint
                        pNewFeature.Store()

                        pEnumSegment.Next(pSegment, outPartIndex, segmentIndex)
                    Loop
                End If
                pFeature = pEnumFeature.Next
            Loop

            pLELProps = New LabelEngineLayerProperties
            pLELProps.Expression = "[Length]"
            pLELProps.IsExpressionSimple = True
            pAnnoLyrProps = pLELProps
            pAnnoLyrProps.DisplayAnnotation = True

            pGeoFLayer = pFLayer
            pGeoFLayer.AnnotationProperties.Clear()
            pGeoFLayer.AnnotationProperties.Add(pAnnoLyrProps)

            pMxDoc.ActiveView.Refresh()