📄 ae缓冲区代码.txt
字号:
AE缓冲区代码
By yumao 发表于 2007-7-17 20:52:00
Dim pPoint1 As IPoint
Dim pPoint2 As IPoint
Dim pEnv As IEnvelope
pPoint1 = New Point
pPoint2 = New Point
pMap = AxMapControl1.Map
pActiveView = pMap
pEnv = New Envelope
pEnv = pActiveView.Extent.Envelope
pPoint1.PutCoords(635359.486, 3089969.118) '第一幅图的右上角点
pPoint2.PutCoords(635359.486, 3089599.435) '第一幅图的右下角点
'用第一幅图的右上角与右下角点生成一条直线,然后生成缓冲区
Dim pPolyline As IGeometryCollection
pPolyline = New Polyline
Dim pPath As ISegmentCollection
pPath = New ESRI.ArcGIS.Geometry.Path
Dim pLine As ILine
pLine = New Line
pLine.PutCoords(pPoint1, pPoint2)
pPath.AddSegment(pLine)
pPolyline.AddGeometry(pPath)
'以下代码是将缓冲区用颜色填充
Dim pFillSym As ISimpleFillSymbol
pFillSym = New SimpleFillSymbol
Dim pColor As IRgbColor
pColor = New RgbColor
pColor.Red = 0
pColor.Green = 255
pColor.Blue = 0
pFillSym.Color = pColor
'pFillSym.Outline = 2
pFillSym.Style = esriSimpleFillStyle.esriSFSSolid
pScrD = pActiveView.ScreenDisplay
'对线作缓冲区
Dim pGeometry As IGeometry
pGeometry = pPolyline
Dim length As Double
Dim pTopo As ITopologicalOperator
pTopo = pGeometry
Dim pBuffer As IGeometry
length = ConvertPixelsTomapUnits(pMap, 4)
pBuffer = pTopo.Buffer(length)
pGeometry = pBuffer.Envelope
'将缓冲区显示出来
With pScrD
.StartDrawing(pScrD.hDC, 1)
.SetSymbol(pFillSym)
.DrawPolygon(pBuffer)
.FinishDrawing()
End With
'第一幅图与该缓冲区作查询,找出与该缓冲区相交的等高线
Dim pSFilter As ISpatialFilter
Dim pQFilter As IQueryFilter
pSFilter = New SpatialFilter
pQFilter = New QueryFilter
pSFilter.Geometry = pGeometry
pFeatureLyr1 = pMap.Layer(0) '第一幅等高线图
pFeatureCls = pFeatureLyr1.FeatureClass
Select Case pFeatureCls.ShapeType
Case esriGeometryType.esriGeometryPolyline
pSFilter.SpatialRel = esriSpatialRelEnum.esriSpatialRelCrosses
Case esriGeometryType.esriGeometryPolygon
pSFilter.SpatialRel = esriSpatialRelEnum.esriSpatialRelIntersects
End Select
pSFilter.GeometryField = pFeatureCls.ShapeFieldName
pQFilter = pSFilter
Dim pACursor As IFeatureCursor
Dim pBCursor As IFeatureCursor
pACursor = pFeatureLyr1.Search(pQFilter, False)
Dim pFeature As IFeature
'pFeatureCls = Nothing
'pFeatureCursor = Nothing
'pFeature = Nothing
pFeatureLyr2 = pMap.Layer(1) '第二幅等高线图,在第一幅图的右边
pFeatureCls = pFeatureLyr2.FeatureClass
Select Case pFeatureCls.ShapeType
Case esriGeometryType.esriGeometryPolyline
pSFilter.SpatialRel = esriSpatialRelEnum.esriSpatialRelCrosses
Case esriGeometryType.esriGeometryPolygon
pSFilter.SpatialRel = esriSpatialRelEnum.esriSpatialRelIntersects
End Select
pSFilter.GeometryField = pFeatureCls.ShapeFieldName
pQFilter = pSFilter
pBCursor = pFeatureLyr2.Search(pQFilter, False)
pMap.ClearSelection()
pFeature = pBCursor.NextFeature
While Not pFeature Is Nothing
pMap.SelectFeature(pFeatureLyr2, pFeature)
pFeature = pBCursor.NextFeature
End While
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -