📄 vba13-7.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 + -