⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 vba13-7.txt

📁 AO的原代码,都是以TXT的文件写的,对你肯定有帮助的.这些都是 我的心血啊.
💻 TXT
字号:
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

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -