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, 
NothingNothing
        pAnnoPropscoll.Add pAnnoLayerProps
    
Next
  

    
'create new annotation class
    Dim pNewFC As IFeatureClass
    
Set pNewFC = pAnnoWS.CreateAnnotationClass(pFCName, pAllFields, pAnnoObjClassDesc.InstanceCLSID, _
                                               pAnnoObjClassDesc.ClassExtensionCLSID, pFC.ShapeFieldName, _
                                                
""NothingNothing, 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/04/03/1428697.html

你可能感兴趣的:(Access)