vba代码.txt

关于常用的VBA的代码

ao绘制箭头
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





















qq:1526005
所谓AO，现在一般都是指ArcGIS Desktop版本的组件开发集，即需要安装ArcGIS桌面版软件后才能安装这些组件开发集，它是所有版本中组件最全的版本，如果想对ArcGIS产品及其开发有个详尽的了解，学习AO是最恰当的。AO版本包括了所有的类库，其中包括ArcMap、ArcMapUI、ArcCatalog、ArcCatalogUI等组件库，这些组件库必须在安装了桌面版软件后才能使用。

    由于使用AO开发的程序必须安装桌面版软件，这使得它的开发成本大大增加。处于产品策略上的考虑，ESRI将AO中的某些组件集单独封装出来，起名为AE，使用AE开发的软件需要在一个RUNTIME下运行，而不需要安装ArcGIS软件。

    因此，AE只是AO的一个子集，使用AE开发的软件，在AO环境中使用没有问题，但是AO开发的程序，如果使用的组件库不被包含在AE中，就无法使用，比如IIdentifyDialog对象，就是只有在AO中才能使用。除此以外，AO版本的控件只有MapControl和PageLayoutControl两个，而AE的控件就丰富的多。
 
 


AO+VB：怎样实现特征的选择 
整理时间 [2004-09-11]   阅读次数 [2536] 

作者：hy2003al    

--------------------------------------------------------------------------------
 
文字大小：【大】【中】【小】  
try this:

Option Explicit
Private selflag As Boolean        '选择标志
Private Sub Command1_Click()
selflag = True
End Sub

Private Sub Form_Load()
selflag = False

End Sub

Private Sub MapControl1_OnMouseDown(ByVal button As Long, ByVal shift As Long, ByVal x As Long, ByVal y As Long, ByVal mapX As Double, ByVal mapY As Double)
If selflag = True Then
        Dim pSelEnv As ISelectionEnvironment
        Dim pRgbColor As IRgbColor
        Set pSelEnv = New SelectionEnvironment
        Set pRgbColor = New RgbColor
        pRgbColor.Red = 255
        pSelEnv.AreaSelectionMethod = esriSpatialRelIntersects
        Set pSelEnv.DefaultColor = pRgbColor
        
        Dim pEnv As IEnvelope
        Dim pRubber As IRubberBand
        Set pRubber = New RubberEnvelope
        
        Dim pActiveView As IActiveView
        Set pActiveView = MapControl1.ActiveView
        Set pEnv = pRubber.TrackNew(pActiveView.ScreenDisplay, Nothing)
        
        pActiveView.PartialRefresh esriViewGeoSelection, Nothing, Nothing
        MapControl1.Map.SelectByShape pEnv, pSelEnv, False