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

📄 ae缓冲区代码.txt

📁 这是关于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 + -