AE常用代码(标注要素、AE中画带箭头的线、如何获得投影坐标、参考坐标、投影方式、FeatureCount注意事项)

手上的电脑已经用了将近三年了,想入手一台Surface Pro,所以计划着把电脑上的资料整理下,部分资料打算发到博客上来,资料有同事、也有自己的、也有来自网络的,来源途径太多,也没法详细注明,请见谅!

要素标注:

在Engine中,有一个很好的接口IGraphicsContainer,这个接口就是desktop中的临时图层,所以,要是完成一个标注功能的系统,这个接口就非常有用了。可以通过IMap、IActiveView等接口得到IGraphicsContainer,通过
IGraphicsContainer pGC = m_HookHelper.FocusMap as IGraphicsContainer;
            pGC.Reset();
            IElement pElement = pGC.Next();
            while (pElement != null)
            {
                ElemnetProperty pProperty = (pElement as IElementProperties2).CustomProperty as ElemnetProperty;
                if(pProperty == null)
                {
                    pElement = pGC.Next();
                    continue;
                }
            }
对其中的IElement进行遍历,通过IElement得到IElementProperties2,IElementProperties2的CustomProperty是个可读写的object属性,可以通过他保存自定义的内容,所以属性控制方面,非常方便;IElement的Geometry属性可以控制图形,图形方面的问题也得到了解决。(上段代码中的ElemnetProperty 是我自己定义的一个结构。)

控制PageLayout显示
PageLayout上的东西都是element,实现了两个接口IGraphicsContainer and IGraphicsContainerSelect。IGraphicsContainer包括所有pagelayout上的element,有next方法可以遍历,可以添加删除排序,IGraphicsContainerSelect has a DominantElement property for getting the selected element. 一个element又实现了IElementProperties2接口,该接口上有name属性,可以通过这个属性来get or set the name of selected element。在element的ITextElement (并非所有的elment都实现该接口可以用Typeof pElement is ITextElement判断)接口上有text属性,可以来设置其显示的文字。
'get PageLayout

    Dim pMxDoc As IMxDocument
    Set pMxDoc = ThisDocument

    Dim pPageLayout As IPageLayout
    Set pPageLayout = pMxDoc.PageLayout

    'determine if there is one and only one element selected

    Dim pContainerSelect As IGraphicsContainerSelect
    Set pContainerSelect = pPageLayout

    If pContainerSelect.ElementSelectionCount <> 1 Then
        MsgBox "Select one element."
        Exit Sub
    End If

    'get the name property

    Dim pElement As IElementProperties2
    Set pElement = pContainerSelect.DominantElement

    Dim strName As String
    strName = InputBox("Enter a name", "Name the element")

    'set the name property
        pElement.Name = strName
添加新图形(Adding new graphics)
先声明一个IElement 这个接口根据需要可以在polygon, line或point 上实现。用来接收geometry;
声明一个IFillShapeElement接口引用刚才那个对象,用它的symbol属性来设置element的属性。
用symbol的color属性来设置颜色和透明度,outline属性来设置边框
最后用IGraphicsContainer的add方法把element加上去。
IElement 有geometry 属性,来接受一个geometry
IFillShapeElement有symbol属性
IFillSymbol有color属性来设置symbol的颜色透明度等,还有outline属性来设置边框

AE中画带箭头的线(转贴)

使用ICartographicLineSymbol 接口
Private Sub UIButtonControl1_Click()
Dim pMxDoc As IMxDocument
Dim pGraphicsContainer As IGraphicsContainer
Dim pActiveView As IActiveView
Dim pLineElement As ILineElement


Set pMxDoc = Application.Document
Set pGraphicsContainer = pMxDoc.FocusMap
Set pActiveView = pMxDoc.FocusMap
pGraphicsContainer.Reset
Set pLineElement = pGraphicsContainer.Next

Dim aCartoLineSymbol As ICartographicLineSymbol
Set aCartoLineSymbol = New CartographicLineSymbol
Dim aLP As ILineProperties
Set aLP = aCartoLineSymbol
aLP.Offset = 0
Dim hpe(6) As Double
hpe(0) = 0
hpe(1) = 7
hpe(2) = 1
hpe(3) = 1
hpe(4) = 1
hpe(5) = 0
Dim eLineTemplate As ITemplate
Set eLineTemplate = New Template
eLineTemplate.Interval = 1
Dim ix As Integer, jx As Integer
jx = 0
For ix = 1 To 3
eLineTemplate.AddPatternElement hpe(jx), hpe(jx + 1)
jx = jx + 2
Next ix
Set aLP.Template = eLineTemplate
aCartoLineSymbol.Width = 2
aCartoLineSymbol.Cap = esriLCSButt
aCartoLineSymbol.Join = esriLJSBevel
Dim HC As IRgbColor
Set HC = New RgbColor
HC.Red = 255
HC.Green = 0
HC.Blue = 0
aCartoLineSymbol.Color = HC
Dim pSymbol As ISymbol
Set pSymbol = aCartoLineSymbol
pLineElement.Symbol = pSymbol
pActiveView.Refresh

End Sub 

引线标注

  Dim pMxDoc As IMxDocument
  Set pMxDoc = ThisDocument
 
  Dim pTextElement As ITextElement
  Set pTextElement = New TextElement
  Dim pElement As IElement
  Set pElement = pTextElement
  pTextElement.Text = "feifeiwua" & vbCrLf & "引线标注!"
 
  Dim dMidX As Double, dMidY As Double
  Dim pPoint As IPoint
'  dMidX = (pMxDoc.ActiveView.Extent.XMax + pMxDoc.ActiveView.Extent.XMin) / 2
'  dMidY = (pMxDoc.ActiveView.Extent.YMax + pMxDoc.ActiveView.Extent.YMin) / 2
  Set pPoint = New Point
  Set pPoint = pMxDoc.ActivatedView.ScreenDisplay.DisplayTransformation.ToMapPoint(x, y)
  dMidX = pPoint.x
  dMidY = pPoint.y
  pPoint.PutCoords dMidX, dMidY
  pElement.Geometry = pPoint
 
  Dim pTextSymbol As IFormattedTextSymbol
  Set pTextSymbol = New TextSymbol
  Dim pCallout As ICallout
  Set pCallout = New BalloonCallout
  Set pTextSymbol.Background = pCallout
  pPoint.PutCoords dMidX - pMxDoc.ActiveView.Extent.Width / 4, dMidY + pMxDoc.ActiveView.Extent.Width / 20
  pCallout.AnchorPoint = pPoint
 
  pTextElement.Symbol = pTextSymbol
  Dim pGraphicsContainer As IGraphicsContainer
  Set pGraphicsContainer = pMxDoc.ActiveView
  pGraphicsContainer.AddElement pElement, 0
  pElement.Activate pMxDoc.ActiveView.ScreenDisplay
  pMxDoc.ActiveView.PartialRefresh esriViewGraphics, Nothing, Nothing


如何获得投影坐标、参考坐标、投影方式

ArcMap中,View——〉Data Frame Properties——〉Coordinate System:
有一系列的坐标及投影方式,可以通过以下方式获得
Public Sub getSpatialReference()
    Dim pDoc As IMxDocument
    Dim pMap As IMap
   
    Set pDoc = ThisDocument
    Set pMap = pDoc.FocusMap
   
    Dim pSpatialReference As ISpatialReference
   
    Set pSpatialReference = pMap.SpatialReference
   
    Dim pProjectedCS As IProjectedCoordinateSystem
    Dim pGeographicCS As IGeographicCoordinateSystem
    Dim pProjection As IProjection
   
    Set pProjectedCS = pSpatialReference
    Set pGeographicCS = pProjectedCS.GeographicCoordinateSystem
    Set pProjection = pProjectedCS.Projection
   
    Debug.Print pProjectedCS.Name
    Debug.Print pGeographicCS.Name
    Debug.Print pProjection.Name
End Sub

输出结果:
NAD_1983_StatePlane_Vermont_FIPS_4400
GCS_North_American_1983
Transverse_Mercator:横轴墨卡托投影


IFeatureClass::FeatureCount注意点
IFeatureClass.FeatureCount(ISpatialFilter):计算FeatureCount的时候,如果ISpatialFilter::Geometry过于复杂,此方法运算会使程序崩溃(比如:把道路网做缓冲合并成一个Geometry,查询程序崩溃)。
可以采取另外的一个方法:
IFeatureCursor = IFeatureClass.Search(ISpatialFilte*,**lse),然后遍历IFeatureCursor,获得其个数。

posted @ 2013-09-05 21:26  一点味  阅读(2306)  评论(0编辑  收藏  举报