將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