关于注记的转换两种方法[转帖]

这里提供两种方法，第一种pFDOGraphicsLayer.DoAddFeature Nothing, CreateElement, 0，这里如果用nothing参数，似乎只能转一个属性，转第二次时vb会彻底退出
第二种方法对要转选择部分属性的注记比较好，速度也不是很慢，可以结合ifeaturecursor和ifeaturebuffer接口看看，我试过，但我的数据会使vb崩溃，不知道是否使数据的原因
还有一种通用的不带属性转入的方法，就不多说了，那中方法是最快的

Public Sub CreateAnnoFeature()
  On Error GoTo ErrorHandler
  Dim pEditor As IEditor
  Dim pFWorkspace As IFeatureWorkspace
  
  Set pEditor = Application.FindExtensionByName("ESRI Object Editor"
  Set pFWorkspace = pEditor.EditWorkspace
  If pFWorkspace Is Nothing Then
    MsgBox "You must be editing"
    Exit Sub
  End If
  
  Dim pEditLayers As IEditLayers
  Dim pLayer As ILayer
  Dim pFDOGraphicsLayer As IFDOGraphicsLayer
  Set pEditLayers = pEditor
  Set pLayer = pEditLayers.CurrentLayer
  
  pEditor.StartOperation
  
  Set pFDOGraphicsLayer = pLayer
  pFDOGraphicsLayer.BeginAddElements
  pFDOGraphicsLayer.DoAddFeature Nothing, CreateElement, 0
  pFDOGraphicsLayer.EndAddElements
  
  pEditor.StopOperation "Create Anno Feature"
  
  Dim pMxDoc As IMxDocument
  Dim pActiveView As IActiveView
  Set pMxDoc = ThisDocument
  Set pActiveView = pMxDoc.FocusMap
  pActiveView.Refresh
  Exit Sub
ErrorHandler:
  MsgBox Err.Description
  pEditor.AbortOperation
End Sub

Public Sub CreateAnnoFeature2()
  On Error GoTo ErrorHandler
  Dim pEditor As IEditor
  Dim pFWorkspace As IFeatureWorkspace
  Dim pFClass As IFeatureClass
  
  Set pEditor = Application.FindExtensionByName("ESRI Object Editor"
  Set pFWorkspace = pEditor.EditWorkspace
  If pFWorkspace Is Nothing Then
    MsgBox "You must be editing"
    Exit Sub
  End If
  
  Set pFClass = pFWorkspace.OpenFeatureClass("GIS.GIS.TestAnno"
  Dim pFeature As IFeature
    
  pEditor.StartOperation
  
  Set pFeature = pFClass.CreateFeature
  Dim pAnnotationFeature As IAnnotationFeature
  Set pAnnotationFeature = pFeature
  Dim pElement As IElement
  Set pElement = CreateElement
  pAnnotationFeature.Annotation = pElement
  pFeature.Store
  
  pEditor.StopOperation "Create Anno Feature"
  
  Dim pMxDoc As IMxDocument
  Dim pActiveView As IActiveView
  Set pMxDoc = ThisDocument
  Set pActiveView = pMxDoc.FocusMap
  pActiveView.Refresh
  Exit Sub
ErrorHandler:
  MsgBox Err.Description
  pEditor.AbortOperation
End Sub

Private Function CreateElement() As IElement
  Dim pMxDoc As IMxDocument
  Set pMxDoc = ThisDocument
  
  Dim pActiveView As IActiveView
  Set pActiveView = pMxDoc.FocusMap
  
  Dim pArea As IArea
  Set pArea = pActiveView.Extent
  
  Dim pClone As IClone
  Set pClone = pArea.Centroid
  
  Dim pPoint1 As IPoint
  Set pPoint1 = pClone.Clone
  
  Dim pPoint2 As IPoint
  Set pPoint2 = pClone.Clone
  pPoint2.x = pPoint2.x + 1
  
  Dim pPointCollection As IPointCollection
  Set pPointCollection = New Polyline
  pPointCollection.AddPoint pPoint1
  pPointCollection.AddPoint pPoint2
    
  Dim pTextElement As ITextElement
  Set pTextElement = New TextElement
  pTextElement.Text = "This is text"
  
  Dim pElement As IElement
  Set pElement = pTextElement
  pElement.Geometry = pPointCollection
  
  Set CreateElement = pElement
End Function