SDE如何Export Anno到PGDB

将SDE里的Annotation featureclass到处到 personal geodatabase.

其中，pFC为SDE里要导出的Annotation featureclass, pWSN是Access workspaceName.

 

Public Sub ExportAnno(pFC As IFeatureClass, pFilter As IQueryFilter, pAccessWorkspaceName As IWorkspaceName)
    
    Dim pWSName As IName
    Set pWSName = pAccessWorkspaceName  ' QI to IName to open
    
    Dim pAnnoWS As IFeatureWorkspaceAnno
    Set pAnnoWS = pWSName.Open
   
    Dim pWS As IWorkspace
    Set pWS = pAnnoWS
    
    ' create the feature class description to get the necessary CLSIDs
    Dim pAnnoFCDesc As IFeatureClassDescription
    Set pAnnoFCDesc = New AnnotationFeatureClassDescription
    
    ' QI to the annotation object class description for another necesasry CLSID
    Dim pAnnoObjClassDesc As IObjectClassDescription
    Set pAnnoObjClassDesc = pAnnoFCDesc
    
    
    Dim position As Integer
    position = InStr(pFC.AliasName, ".")
                        
    Dim pFCName As String
    If position > 0 Then
        pFCName = Right(pFC.AliasName, Len(pFC.AliasName) - position)
    Else
        pFCName = pFC.AliasName
    End If
    
    'generate fields of new featureclass
    Dim pAllFields As IFields
    Set pAllFields = New Fields
    Dim pFieldsEdit As IFieldsEdit
    Set pFieldsEdit = pAllFields
    Dim i As Integer
    For i = 0 To pFC.Fields.FieldCount - 1
     pFieldsEdit.AddField pFC.Fields.Field(i)
    Next


    Dim pAnnoClass As IAnnoClass
    Set pAnnoClass = pFC.Extension
    
    'get symbolcollection of old featureclass
    Dim pSColl As ISymbolCollection
    Set pSColl = pAnnoClass.SymbolCollection
    
    'get reference and scale of old featureclass
    Dim pRefScale As IGraphicsLayerScale
    Set pRefScale = New GraphicsLayerScale
    pRefScale.Units = pAnnoClass.ReferenceScaleUnits
    pRefScale.ReferenceScale = pAnnoClass.ReferenceScale
         
    Dim pAnnoLayerPropsColl As IAnnotateLayerPropertiesCollection
    Dim pAnnoPropscoll As IAnnotateLayerPropertiesCollection
    Set pAnnoPropscoll = New AnnotateLayerPropertiesCollection
    Set pAnnoLayerPropsColl = pAnnoClass.AnnoProperties

    'get the (first) AnnotateLayerProperties property set in the collection
    Dim pAnnoLayerProps As IAnnotateLayerProperties
    
    For i = 0 To pAnnoLayerPropsColl.Count - 1
        pAnnoLayerPropsColl.QueryItem i, pAnnoLayerProps, Nothing, Nothing
        pAnnoPropscoll.Add pAnnoLayerProps
    Next
  

    'create new annotation class
    Dim pNewFC As IFeatureClass
    Set pNewFC = pAnnoWS.CreateAnnotationClass(pFCName, pAllFields, pAnnoObjClassDesc.InstanceCLSID, _
                                               pAnnoObjClassDesc.ClassExtensionCLSID, pFC.ShapeFieldName, _
                                                "", Nothing, Nothing, pAnnoPropscoll, pRefScale, pSColl, True)
                         
    Dim pDataset As IDataset
    Set pDataset = pNewFC
    
    Dim pTransactions As ITransactions
    Set pTransactions = pDataset.Workspace
    pTransactions.StartTransaction
    Const lAutoCommitInterval = 100
    
    Dim pFDOGLFactory As IFDOGraphicsLayerFactory
    Set pFDOGLFactory = New FDOGraphicsLayerFactory
    
    Dim pFDOGLayer As IFDOGraphicsLayer
    Set pFDOGLayer = pFDOGLFactory.OpenGraphicsLayer(pWS, pNewFC.FeatureDataset, pDataset.Name)
    
    Dim pTextElement As ITextElement
    
    Dim lRowCount As Long
    lRowCount = 0
    
    Dim pElementColl As IElementCollection
    Set pElementColl = New ElementCollection
    pFDOGLayer.BeginAddElements
    
    
    Dim pfeature As IFeature
    Dim pFeatureCursor As IFeatureCursor
    
    Set pFeatureCursor = pFC.Search(pFilter, False)
    Set pfeature = pFeatureCursor.nextfeature
           
    Do While Not pfeature Is Nothing
        Dim pAnnoFea As IAnnotationFeature
        Set pAnnoFea = pfeature
       
        Set pTextElement = pAnnoFea.Annotation
    
        pElementColl.Add pTextElement
        
        lRowCount = lRowCount + 1
     
        If lRowCount Mod lAutoCommitInterval = 0 Then
            pFDOGLayer.DoAddElements pElementColl, 0
            pElementColl.Clear
            pTransactions.CommitTransaction
            pTransactions.StartTransaction
        End If
    
        Set pfeature = pFeatureCursor.nextfeature
    Loop
    If pElementColl.Count > 0 Then pFDOGLayer.DoAddElements pElementColl, 0
    pElementColl.Clear
    pTransactions.CommitTransaction
    
    Set pNewFC = Nothing
    pFDOGLayer.EndAddElements
    Set pFDOGLayer = Nothing
   

    Set pNewFC = Nothing
  
    Set pFeatureCursor = Nothing
    Set pfeature = Nothing
    Set pAnnoFCDesc = Nothing
    Set pAnnoObjClassDesc = Nothing
    Set pAllFields = Nothing
    Set pFieldsEdit = Nothing
    Set pAnnoWS = Nothing
    Set pWSName = Nothing
    Set pAnnoClass = Nothing
    Set pRefScale = Nothing
    Set pAnnoPropscoll = Nothing

End Sub