Set pFeatureCursor = pFeatureclass.Update(pFilter, False) Set pFeature = pFeatureCursor.NextFeature While Not pFeature Is Nothing Dim pAnnoFeat As IAnnotationFeature Set pAnnoFeat = pFeature Dim pElement As IElement Set pElement = pAnnoFeat.Annotation Dim pTextElement As ITextElement Set pTextElement = pElement Dim pTextSym As ISimpleTextSymbol Set pTextSym = pTextElement.Symbol If Not pTextSym Is Nothing Then Dim pTextPath As ITextPath Set pTextPath = pTextSym.TextPath If TypeOf pTextPath Is IOverposterTextPath Then If TypeOf pElement.Geometry Is IPolyline Then Dim pPointCol As IPointCollection Set pPointCol = New Polyline Set pPointCol = pElement.Geometry ' Just keep start- and endpoint pPointCol.RemovePoints 1, pPointCol.PointCount - 2 '....... Replace textPath here ...... pFeatureCursor.UpdateFeature pFeature End If End If End If Set pFeature = pFeatureCursor.NextFeature Wend End If
Solved! Go to Solution.
pElement does't accept any changes. The following code gives me automation errors:'Replace textPath here ...... ' Just keep start- and endpoint Dim pNewPolyline As IPolyline Set pNewPolyline = New Polyline pNewPolyline.fromPoint = pPointCol.Point(0) pNewPolyline.toPoint = pPointCol.Point(pPointCol.PointCount - 1) pElement.Geometry = pNewPolyline '*** automation error *** Dim pNewPointCol As IPointCollection Set pNewPointCol = New Polyline Set pNewPointCol = pNewPolyline pElement.Geometry = pNewPointCol '*** automation error *** pPointCol.RemovePoints 1, pPointCol.PointCount - 2 pElement.Geometry = pPointCol '*** automation error ***
'Replace textPath here ...... ' Just keep start- and endpoint Dim pNewPolyline As IPolyline Set pNewPolyline = New Polyline pNewPolyline.fromPoint = pPointCol.Point(0) pNewPolyline.toPoint = pPointCol.Point(pPointCol.PointCount - 1) Dim pNewTextPath As ITextPath Set pNewTextPath = New SimpleTextPath Set pNewTextPath.Geometry = pNewPolyline Set pTextSym.TextPath = pNewTextPath pFeatureCursor.UpdateFeature pFeature
If TypeOf pElement.Geometry Is IPolyline Then Dim pPointCol As IPointCollection Set pPointCol = pElement.Geometry ' Just keep start- and endpoint pPointCol.RemovePoints 1, pPointCol.PointCount - 2 ''---------------------------- pElement.Geometry = pPointCol pAnnoFeat.Annotation = pElement ''---------------------------- pFeatureCursor.UpdateFeature pfeature End If
There must be missing something. The geometry doesn't change.'Replace textPath here ...... ' Just keep start- and endpoint Dim pNewPolyline As IPolyline Set pNewPolyline = New Polyline pNewPolyline.fromPoint = pPointCol.Point(0) pNewPolyline.toPoint = pPointCol.Point(pPointCol.PointCount - 1) Dim pNewTextPath As ITextPath Set pNewTextPath = New SimpleTextPath Set pNewTextPath.Geometry = pNewPolyline Set pTextSym.TextPath = pNewTextPath pFeatureCursor.UpdateFeature pFeature
'Replace textPath here ...... ' Just keep start- and endpoint Dim pNewPolyline As IPolyline Set pNewPolyline = New Polyline pNewPolyline.fromPoint = pPointCol.Point(0) pNewPolyline.toPoint = pPointCol.Point(pPointCol.PointCount - 1) pElement.Geometry = pNewPolyline '*** automation error *** Dim pNewPointCol As IPointCollection Set pNewPointCol = New Polyline Set pNewPointCol = pNewPolyline pElement.Geometry = pNewPointCol '*** automation error *** pPointCol.RemovePoints 1, pPointCol.PointCount - 2 pElement.Geometry = pPointCol '*** automation error ***
pElement does't accept any changes. The following code gives me automation errors:'Replace textPath here ...... ' Just keep start- and endpoint Dim pNewPolyline As IPolyline Set pNewPolyline = New Polyline pNewPolyline.fromPoint = pPointCol.Point(0) pNewPolyline.toPoint = pPointCol.Point(pPointCol.PointCount - 1) pElement.Geometry = pNewPolyline '*** automation error *** Dim pNewPointCol As IPointCollection Set pNewPointCol = New Polyline Set pNewPointCol = pNewPolyline pElement.Geometry = pNewPointCol '*** automation error *** pPointCol.RemovePoints 1, pPointCol.PointCount - 2 pElement.Geometry = pPointCol '*** automation error ***
'*** edit session running *** If TypeOf pElement.Geometry Is IPolyline Then Dim pPointCol As IPointCollection Set pPointCol = New Polyline Set pPointCol = pElement.Geometry 'Replace textPath here ...... ' Just keep start- and endpoint Dim pNewPolyline As IPolyline Set pNewPolyline = New Polyline pNewPolyline.fromPoint = pPointCol.Point(0) pNewPolyline.toPoint = pPointCol.Point(pPointCol.PointCount - 1) pElement.Geometry = pNewPolyline pAnnoFeat.Annotation = pElement pFeatureCursor.UpdateFeature pFeature End If