CAD Text转到SDE Anno FeatureClass

SDE如何Export Anno到PGDB

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

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

 

Code
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

来自:http://www.cnblogs.com/iswszheng/archive/2009/03/18/1415496.html