vba13-7.txt

来自「本书给出了AO的常用的VAB代码 可能是初学者很好的一本参考书」· 文本 代码 · 共 62 行

Private Function BufferFeatures() As IGeometry
    Dim pMxDocument As IMxDocument
    Dim pActiveView As IActiveView
    Dim pMap As IMap
    Dim pGraphicsContainer As IGraphicsContainer
    Dim strDistanceUnit As String
    Dim strBufferDistance As String
    
    Set pMxDocument = Application.Document
    Set pActiveView = pMxDocument.FocusMap
    Set pGraphicsContainer = pMxDocument.FocusMap
    
    ' Verify a feature is selected
    Set pMap = pMxDocument.FocusMap
    If pMap.SelectionCount = 0 Then Exit Function
    
    ' Get the buffer distance
    strBufferDistance = _
    InputBox("Enter Buffer Distance:", "")
    If strBufferDistance = "" Or _
    Not IsNumeric(strBufferDistance) Then End
    
    ' Build the symbol for the buffer
    Dim pElement As IElement
    Dim pFillShapeElement As IFillShapeElement
    Dim pFillSymbol As IFillSymbol
    Dim pColor As IColor
    Dim pLineSymbol As ILineSymbol
    Set pElement = New PolygonElement
    Set pFillShapeElement = pElement
    Set pFillSymbol = pFillShapeElement.Symbol
    Set pColor = pFillSymbol.Color
    Set pLineSymbol = pFillSymbol.Outline
    pColor.Transparency = 0
    pFillSymbol.Color = pColor
    pColor.Transparency = 255
    pColor.RGB = RGB(255, 0, 0)
    pLineSymbol.Color = pColor
    pLineSymbol.Width = 0.1
    pFillSymbol.Outline = pLineSymbol
    pFillShapeElement.Symbol = pFillSymbol
    
    
    ' Buffer the first selected feature
    Dim pEnumFeature As IEnumFeature
    Dim pTopoOperator As ITopologicalOperator
    Dim pFeature As IFeature
    Set pEnumFeature = _
    pMxDocument.FocusMap.FeatureSelection
    pEnumFeature.Reset
    Set pFeature = pEnumFeature.Next
    Set pTopoOperator = pFeature.Shape
    pElement.Geometry = pTopoOperator. _
    Buffer(CInt(strBufferDistance))
    pGraphicsContainer.AddElement pElement, 0
    pActiveView.PartialRefresh esriViewGraphics, _
    Nothing, Nothing
    
    ' Return the buffer's geometry
    Set BufferFeatures = pElement.Geometry
End Function