欢迎您来到GIS动力

加入收藏 免费注册 用户登陆 帮助中心
首页 新闻动态 技术专栏 银杏树下 学习考研 软件下载 求职招聘 许愿瓶 节日祝福 用户中心 精彩推荐 资源搜索 地图
专栏导航: AO开发 | SO开发 | ArcGIS桌面 | 超图桌面 | 开发语言 | 数据库 | WebGIS | 银杏文学 | 研究生考题 | FreeMap FreeTalk
   您现在位于: 首页技术专栏ArcGIS应用与开发AO开发 → 正文
向Annotation图层添加feature
08-06-13 08:54:10 作者:本站 出处:本站
从文本文件中读取数据添加到Annotation图层

Public Sub AppendAnnoFeatures(pFeatureClass As IFeatureClass, _
strTextFile As String)

Dim pAnnoClass As IAnnoClass
Set pAnnoClass = pFeatureClass.Extension
If pAnnoClass Is Nothing Then
  MsgBox "Annotation Class not found"
  Exit Sub
End If

'****************
' 打开文本文件并读取文件
'****************
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

'****************
' 开始数据库处理事务,并设置为自动提交
'****************
Dim pDataset As IDataset
Dim pTransactions As ITransactions
Set pDataset = pFeatureClass
' Inline QI to ITransactions
Set pTransactions = pDataset.Workspace
pTransactions.StartTransaction
Const lAutoCommitInterval = 100

'****************
' 设置FDOGraphicsLayer - 这是插入annotation的最有效的方法
'****************
Dim pFDOGLFactory As IFDOGraphicsLayerFactory
Set pFDOGLFactory = New FDOGraphicsLayerFactory

Dim pFDOGLayer As IFDOGraphicsLayer
Set pFDOGLayer = pFDOGLFactory.OpenGraphicsLayer(pDataset.Workspace, pFeatureClass.FeatureDataset, pDataset.Name)

Dim pElementColl As IElementCollection
Set pElementColl = New ElementCollection
pFDOGLayer.BeginAddElements

'****************
' 处理没一行文件数据,直到文件结束
'****************
Dim lRowCount As Long
lRowCount = 0
Do While Not EOF(lFreeFile)
  Input #lFreeFile, sText, dX, dY, dAngle ' Read line of data

  '****************
  ' 创建text element并把它加入到element collection
  '****************
  Set pTextElement = MakeTextElement(sText, dX, dY, dAngle)
  pElementColl.Add pTextElement
  lRowCount = lRowCount + 1

  '****************
  '提交
  '****************
  If lRowCount Mod lAutoCommitInterval = 0 Then
   pFDOGLayer.DoAddElements pElementColl, 0
   pElementColl.Clear
   pTransactions.CommitTransaction
   pTransactions.StartTransaction
  End If

Loop
Close lFreeFile ' 关闭文件.

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

pFDOGLayer.EndAddElements
pTransactions.CommitTransaction

End Sub

'以下代码是用来创建Text Element
Public Function MakeTextElement(sText As String, _
dX As Double, _
dY As Double, _
dAngle As Double) As ITextElement

' Create new text element
Dim pTextElement As ITextElement
Set pTextElement = New TextElement
pTextElement.ScaleText = True
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 pGroupSymbolElement As IGroupSymbolElement
Set pGroupSymbolElement = pTextElement
pGroupSymbolElement.SymbolID = 0

' 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
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


(本文已被浏览 次)
发布人:admin
推荐给好友:发送给好友
上篇新闻:
下篇新闻:
相关评论
发表我的评论
  • 尊重网上道德,遵守《全国人大常委会关于维护互联网安全的决定》及中华人民共和国其他各项有关法律法;
  • 本站有权保留或删除您发表的任何评论内容;
  •   相关文章  
    把Annotation转换为Polygon Features
    AE创建Annotation
    AE指定字段转成注记
    CRS-0184: Cannot communicate with the CRS daemon
    标注与注记(Label与Annotation)关系与区别
    Annotation小感

    关于我们友情链接 ┋ 与我在线 ┋ 管理 ┋ TOP
     
    网站当前版本:GisPower CMS V3.0
    『GIS 动力』- http://www.gispower.org/
    联系我们:webmaster#gispower.org
    Copyright (c) 2003-2007 GisPOwer.Org. All Rights Reserved.
     

                   滇ICP备05006901号