Convert a textfile to an annotation class

' Copyright 2008 ESRI
' All rights reserved under the copyright laws of the United States
' and applicable international laws, treaties, and conventions.
' You may freely redistribute and use this sample code, with or
' without modification, provided you include the original copyright
' notice and use restrictions.
' See use restrictions at <your ArcGIS install location>/developerkit/userestrictions.txt.

Option Explicit

Public Function ImportAnnoMain(pFeatureDataSet As IFeatureDataset, _
                          strFCName As String, _
                          strInputFile As String, _
                          dRefScale As Double, _
                          strFont As String, _
                          iFontSize As Integer) As Boolean

  If TableExists(strFCName, pFeatureDataSet) Then
    MsgBox "Feature class " & strFCName & " already exists"
    ImportAnnoMain = False
    Exit Function
  End If
  ' Make a symbol for the annotation to be inserted
  ' It is possible to have a different symbol for each piece of
  ' annotation, but for this sample we will just use one style of text.
  Dim pTextSymbol As ITextSymbol
  Set pTextSymbol = MakeTextSymbol(strFont, iFontSize)
  ' Get an exclusive lock on the feature dataset
  Dim pSchLock As ISchemaLock
  Set pSchLock = pFeatureDataSet
  On Error Resume Next
  pSchLock.ChangeSchemaLock esriExclusiveSchemaLock
  If Err.Number <> 0 Then
    MsgBox pFeatureDataSet.Name & " is in use" & vbNewLine & Err.Description
    ImportAnnoMain = False
    Exit Function
  End If
  On Error GoTo 0

  ' Create the annotation feature class
  Dim pAnnoLayer As IAnnotationLayer
  Set pAnnoLayer = CreateAnnoFeatureClass(strFCName, pFeatureDataSet, dRefScale, pTextSymbol)

  ' Insert the features
  Call AppendAnnoFeatures(pAnnoLayer, strInputFile)

  ' Release the exclusive lock on the feature dataset
  pSchLock.ChangeSchemaLock esriSharedSchemaLock
  ImportAnnoMain = True
End Function

Public Function CreateAnnoFeatureClass(strName As String, _
                                       pFeatureDataSet As IFeatureDataset, _
                                       dRefScale As Double, _
                                       pTextSymbol As ITextSymbol) As IAnnotationLayer
  ' note that this implementation requires a feature dataset.
  ' It is possible to create a stand-alone annotation feature class,
  ' but then the spatial reference would need to be set on the geometry field
  ' Get the fields required for an Annotation feature class
  Dim pField As IField
  Dim pFields As IFields
  Dim pGeodataset As IGeoDataset
  Dim pGeomDefEdit As IGeometryDefEdit
  Dim pSource As IClone
  Dim pSpatialReference As ISpatialReference
  Dim pObjectClassDesc As IObjectClassDescription
  Dim pFeatClassDesc As IFeatureClassDescription
  Set pObjectClassDesc = New AnnotationFeatureClassDescription
  Set pFeatClassDesc = pObjectClassDesc
  Set pSource = pObjectClassDesc.RequiredFields
  Set pFields = pSource.Clone
  Set pGeodataset = pFeatureDataSet
  Set pSpatialReference = pGeodataset.SpatialReference
  ' Set up a geometry defintion
  Set pField = pFields.Field(pFields.FindField(pFeatClassDesc.ShapeFieldName)) 'get the field definition for the shape field
  Set pGeomDefEdit = pField.GeometryDef 'get the geometry defintion for the field
  Set pGeomDefEdit.SpatialReference = pSpatialReference 'set the spatial reference on the field
  pGeomDefEdit.GridCount = 1
  If TypeOf pSpatialReference Is IGeographicCoordinateSystem Then
    pGeomDefEdit.GridSize(0) = 0.1
    pGeomDefEdit.GridSize(0) = 1000
  End If

  ' Set up a reference scale
  Dim pGraphicsLayerScale As IGraphicsLayerScale
  Set pGraphicsLayerScale = New GraphicsLayerScale
  pGraphicsLayerScale.ReferenceScale = dRefScale
  pGraphicsLayerScale.Units = esriMeters 'this property is only used for UnknownSpatialReferences as a reference scale is unitless

  ' Set up the symbol collection.
  ' Each individual annotation feature will refer to a symbol in the collection
  ' by ID rather than storing the symbol in-line.
  Dim pSymbolColl As ISymbolCollection2
  Dim pSymbolIdent As ISymbolIdentifier2
  Set pSymbolColl = New SymbolCollection
  pSymbolColl.AddSymbol pTextSymbol, "Symbol 1", pSymbolIdent

  ' Set up the labeling properties as they are necessary for annotation feature classes now
  ' We'll use standard label engine properties as this feature class will now be feature linked and not use Maplex
  Dim pOverposterProperties As IOverposterProperties
  Dim pAnnoPropsColl As IAnnotateLayerPropertiesCollection
  Dim pLabelEngineLP As ILabelEngineLayerProperties
  Dim pAnnotateLayerProps As IAnnotateLayerProperties
  Set pOverposterProperties = New BasicOverposterProperties
  Set pAnnoPropsColl = New AnnotateLayerPropertiesCollection
  Set pLabelEngineLP = New LabelEngineLayerProperties
  Set pAnnotateLayerProps = pLabelEngineLP
  pAnnotateLayerProps.Class = "Class 1"
  Set pLabelEngineLP.Symbol = pTextSymbol
  pLabelEngineLP.SymbolID = pSymbolIdent.ID
  pAnnoPropsColl.Add pLabelEngineLP

  ' Set the FDOGraphicsLayerFactory object to help create the annotation feature class
  ' This will ensure that the annotation fields etc are created and domains etc setup
  Dim pAnnoLayerFactory As IAnnotationLayerFactory
  Dim pAnnoLayer As IAnnotationLayer
  Set pAnnoLayerFactory = New FDOGraphicsLayerFactory
  Set pAnnoLayer = pAnnoLayerFactory.CreateAnnotationLayer(pFeatureDataSet.Workspace, _
                                                                pFeatureDataSet, strName, _
                                                                pGeomDefEdit, Nothing, pAnnoPropsColl, _
                                                                pGraphicsLayerScale, pSymbolColl, _
                                                                False, False, False, True, pOverposterProperties, "")

  Set CreateAnnoFeatureClass = pAnnoLayer

End Function

Public Sub AppendAnnoFeatures(pAnnoLayer As IAnnotationLayer, _
                              strTextFile As String)
  Dim pFLayer As IFeatureLayer
  Dim pActiveView As IActiveView
  Dim pMap As IMap
  Dim pGraphicsLayer As IGraphicsLayer
  Dim pGeodataset As IGeoDataset
  Dim pSpatialRef As ISpatialReference
  Dim pAnnotationClassExtension As IAnnotationClassExtension
  Dim pDisplay As IDisplay
  Set pFLayer = pAnnoLayer
  If Not pFLayer.Valid Then
    MsgBox "The annotation layer does not reference a valid data source."
  End If
  Set pAnnotationClassExtension = pFLayer.FeatureClass.Extension
  'Here cocreate a map and add the layer.  Then, use the map's screen display to activate the layer
  'The layer needs to be activated for bounds operations to work correctly.
  Set pMap = New Map
  Set pActiveView = pMap
  pMap.AddLayer pFLayer
  Set pGraphicsLayer = pFLayer
  pGraphicsLayer.Activate pActiveView.ScreenDisplay
  'Get the spatial reference
  Set pGeodataset = pFLayer.FeatureClass
  Set pSpatialRef = pGeodataset.SpatialReference
  ' Open text file for reading
  Dim lFreeFile As Long ' File number
  lFreeFile = FreeFile
  Open strTextFile For Input As #lFreeFile
  Dim sText As String   ' Annotation text
  Dim dX As Double      ' Annotation handle X coordinate
  Dim dY As Double      ' Annotation handle Y coordinate
  Dim dAngle As Double  ' Annotation angle in degrees (anticlockwise from due east)
  Dim pTextElement As ITextElement
  ' start the database transaction and set up an auto-commit
  Dim pDataset As IDataset
  Dim pTransactions As ITransactions
  Set pDataset = pFLayer.FeatureClass
  ' Inline QI to ITransactions
  Set pTransactions = pDataset.Workspace
  Const lAutoCommitInterval = 100

  Dim pElementColl As IElementCollection
  Set pElementColl = New ElementCollection
  ' Process each line of the text file, until end of file is reached
  Dim lRowCount As Long
  lRowCount = 0
  Do While Not EOF(lFreeFile)
    Input #lFreeFile, sText, dX, dY, dAngle    ' Read line of data
    ' Create the text element
    ' and add it to the element collectiont
    Set pTextElement = MakeTextElement(sText, dX, dY, dAngle, pSpatialRef, pAnnotationClassExtension.Symbol(0))
    pElementColl.Add pTextElement
    lRowCount = lRowCount + 1
    ' Every so many rows, add the elements in the collection
    ' to the database and commit work
    If lRowCount Mod lAutoCommitInterval = 0 Then
      pAnnoLayer.DoAddElements pElementColl, 0
    End If
  Close lFreeFile    ' Close file.

  ' Commit any left over elements
  If pElementColl.Count > 0 Then
    pAnnoLayer.DoAddElements pElementColl, 0
  End If

End Sub
Public Function MakeTextElement(sText As String, _
                                dX As Double, _
                                dY As Double, _
                                dAngle As Double, pSpatialReference As ISpatialReference, _
                                pSymbol As ISymbol) As ITextElement

  ' Create new text element
  Dim pTextElement As ITextElement
  Set pTextElement = New TextElement
  pTextElement.Text = sText
  ' Set the symbol ID of the element to point to the existing
  ' text symbol in the annotation feature class's symbol collection
  Dim pSymbolCollectionElement As ISymbolCollectionElement
  Set pSymbolCollectionElement = pTextElement
  pSymbolCollectionElement.SharedSymbol(0) = pSymbol
  ' Set the geometry of the text element
  Dim pElement As IElement
  Set pElement = pTextElement
  Dim pPoint As IPoint
  Set pPoint = New Point
  pPoint.PutCoords dX, dY
  Set pPoint.SpatialReference = pSpatialReference 'assign the geometry the spatial reference of the feature class
  pElement.Geometry = pPoint
  ' If Angle is not zero then QI to ITransform2D to rotate the element
  If dAngle <> 0# Then
    Const PI = 3.141592657
    Dim pTransform2D As ITransform2D
    Set pTransform2D = pTextElement
    pTransform2D.Rotate pPoint, (dAngle * (PI / 180))
  End If
  Set MakeTextElement = pTextElement

End Function

Public Function MakeTextSymbol(strFont As String, iFontSize As Integer) As ITextSymbol

  Dim myTxtSym As ISimpleTextSymbol
  Set myTxtSym = New TextSymbol
  '** Set the font
  Dim myFont As IFontDisp
  Set myFont = New StdFont
  myFont.Name = strFont
  myTxtSym.Font = myFont
  '** Set the Color  to be Black (the default)
  Dim myColor As IRgbColor
  Set myColor = New RgbColor
  myTxtSym.Color = myColor
  '** Set other properties
  myTxtSym.Angle = 0
  myTxtSym.RightToLeft = False
  myTxtSym.Size = iFontSize
  myTxtSym.VerticalAlignment = esriTVABottom
  myTxtSym.HorizontalAlignment = esriTHALeft
  Set MakeTextSymbol = myTxtSym

End Function

Private Function TableExists(strName As String, pFeatureDataSet As IFeatureDataset) As Boolean
  On Error GoTo OpenFail
  TableExists = False
  Dim pFeatWorkspace As IFeatureWorkspace
  Set pFeatWorkspace = pFeatureDataSet.Workspace
  Dim pTable As ITable
  Set pTable = pFeatWorkspace.OpenTable(strName)
  If Not pTable Is Nothing Then
   TableExists = True
  End If
  Exit Function

  TableExists = False
End Function