?? 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 + -