CAD Text轉到SDE Anno FeatureClass

將CAD內的Anno Text轉到sde里的Annotation featureclass.對于CAD Text, 它的geometrytype 為Point, 而sde里Annotation featureclass的geometrytype為Polygon,因此IObjectLoader.LoadObjects不適用于轉CAD Text， 只能用IFDOGLFactory.DoAddElements方法.

IFDOGraphicsLayer是專門用于插入annotation feature到geodatabase annotation featureclass的。關于IFDOGraphicsLayer，EDN里有詳細的備注：

 IFDOGraphicsLayer provides a fast mechanism for inserting annotation features into geodatabase annotation feature classes. Adding annotation feature or element should always be done after calling the BeginAddElements method, and after the features or elements are inserted, be sure to issue a call to the EndAddElements method.

If inserting annotation elements without attributes, use the DoAddElements method which takes an enumeration of GraphicElement objects.  If inserting annotation elements with attributes, use the SetupAttributeConversion method to setup the field mapping between the input features and the target annotation feature class, then call DoAddFeature. DoAddFeature will add the element, the placement polygon shape and populate any attributes that are mapped. The SetupAttributeConversion method cannot be called from Visual Basic. Instead, use the SetupAttributeConversion2 method on IFDOAttributeConversion to setup the field mapping. Field mapping should be setup after the BeginAddElements method is called.

Code
Private Function InsertNewRecord_CAD(path As String, pSdeFSW As IFeatureWorkspace, target As String) As Boolean

On Error GoTo err_handle

   'Source
    Dim pCadWSF As IWorkspaceFactory
    Set pCadWSF = New CadWorkspaceFactory
    
    Dim pCadWS As IWorkspace
    Set pCadWS = pCadWSF.OpenFromFile(GetPathName(path, 0), 0)
    
    Dim pCadFWS As IFeatureWorkspace
    Set pCadFWS = pCadWS
    
    Dim pCadFC As IFeatureClass
     On Error Resume Next
    Set pCadFC = pCadFWS.OpenFeatureClass(GetPathName(path, 1) & ":Annotation")
   
    
    If Not pCadFC Is Nothing Then
    
        Dim pCADFeatureCur As IFeatureCursor
        Set pCADFeatureCur = pCadFC.Search(Nothing, False)
       
        Dim pSdeFC As IFeatureClass
        Set pSdeFC = pSdeFSW.OpenFeatureClass(target)
       
        Dim pTextSymbol As ITextSymbol
        Set pTextSymbol = getTextSymbol(pSdeFC)

        Dim pDataset As IDataset
        Set pDataset = pSdeFC
 
        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(pSdeFSW, pSdeFC.FeatureDataset, pDataset.Name)
  
        Dim pTextElement As ITextElement
  
        Dim pAnnoText As String
        Dim pAngle As Double

        Dim pAnnoTextID As Long
        Dim pAngleID As Long
        Dim pTextStringID As Long
        pAnnoTextID = pCadFC.Fields.FindField("Text")
        pAngleID = pCadFC.Fields.FindField("txtAngle")
        
        Dim lRowCount As Long
        lRowCount = 0
        
        Dim pElementColl As IElementCollection
        Set pElementColl = New ElementCollection
        pFDOGLayer.BeginAddElements
       
 
        Dim pCADFeature As IFeature
        Set pCADFeature = pCADFeatureCur.NextFeature
       
        Do While Not pCADFeature Is Nothing
            pAnnoText = pCADFeature.Value(pAnnoTextID)
            pAngle = pCADFeature.Value(pAngleID)
        
            Set pTextElement = MakeTextElement(pCADFeature, pAnnoText, pAngle, pTextSymbol)
          '  pTextElement.Symbol = pTextSymbol
 
            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 pCADFeature = pCADFeatureCur.NextFeature
        Loop
          
        Set pSdeFC = Nothing
        Set pFDOGLayer = Nothing
    End If

    Set pCadFC = Nothing
    Set pCadFWS = Nothing
    Set pCadWS = Nothing
    Set pCadWSF = Nothing
    
    InsertNewRecord_CAD = True
    
    Exit Function


err_handle:
    InsertNewRecord_CAD = False
    MsgBox "Error(" & Err.Number & "): " & Err.Description
    utlWriteInfoLog "[InsertNewRecord_CAD] error number " & Err.Number & " :" & Err.Description
End Function

 

下面是里面要用到的兩個function

Code
Public Function MakeTextElement(pFeature As IFeature, pAnnoText As String, pAngle As Double, pTextSymbol As TextSymbol) As ITextElement
    
    Dim pPoint As IPoint
    Set pPoint = New Point
    Set pPoint = pFeature.Shape
    
    Dim pTextElement As ITextElement
    Set pTextElement = New TextElement
    
    pTextElement.Symbol = pTextSymbol
    pTextElement.ScaleText = True
    pTextElement.Text = pAnnoText
    
    Dim pElement As IElement
    Set pElement = pTextElement
    pElement.Geometry = pPoint
    
    If pAngle <> 0# Then
    
    Dim pTransform2D As ITransform2D
    Set pTransform2D = pTextElement
   pTransform2D.Rotate pPoint, (pAngle * (PI / 180))
  '  pTransform2D.Rotate pPoint, pAngle
    End If
    
    Set MakeTextElement = pTextElement
End Function

 

Code
Public Function getTextSymbol(pFeatureClass As IFeatureClass) As ITextSymbol

    Dim pTextSym As ITextSymbol

    Dim pAnnoClass As IAnnoClass
    Set pAnnoClass = pFeatureClass.Extension

    If Not pAnnoClass.SymbolCollection Is Nothing Then
        Dim pSColl As ISymbolCollection
        Set pSColl = pAnnoClass.SymbolCollection
        pSColl.Reset

        Dim pSymID As ISymbolIdentifier
        Set pSymID = pSColl.Next
        Do Until pSymID Is Nothing
            If TypeOf pSymID.Symbol Is ITextSymbol Then
                Set pTextSym = pSymID.Symbol
            End If
            Set pSymID = pSColl.Next
        Loop
    Else

        Dim pFCur As IFeatureCursor
        Set pFCur = pFeatureClass.Search(Nothing, False)
        Dim pAnnofeat As IAnnotationFeature
        Set pAnnofeat = pFCur.NextFeature
        Do Until pAnnofeat Is Nothing
            If TypeOf pAnnofeat.Annotation Is ITextElement Then
                Set pTextSym = pAnnofeat.Annotation
            End If
            Set pAnnofeat = pFCur.NextFeature
        Loop
    End If


    Set getTextSymbol = pTextSym


End Function

 

转载于:https://www.cnblogs.com/iswszheng/archive/2009/03/18/1415496.html