AE实现Geoprocessing Fit to Display

最新推荐文章于 2016-04-15 10:55:00 发布

转载最新推荐文章于 2016-04-15 10:55:00 发布 · 948 阅读

文章标签：

#object #layer

arcengine 专栏收录该内容

92 篇文章

订阅专栏

本文介绍了一种使用VBA编程实现地图控制件(MapControl)的自定义缩放功能的方法。通过设定栅格图层并调整其显示范围，使得地图能够适配所需的视图区域。该方法涉及地图对象模型的操作，包括地图范围的获取与转换。

将Mapcontrol作为参数

Public Sub FittoDisplay(pMapControl As Object)

Dim pMapCon As IMapControl2
Set pMapCon = pMapControl

Dim pMap As IMap
Dim pActiveView As IActiveView

Set pMap = pMapCon.Map
Set pActiveView = pMap

    Dim pLayer As ILayer
    Dim pRasterLayer As IRasterLayer
    Dim pRaster As IRaster

    Set pLayer = pMap.Layer(0) '设Layer(0)为栅格图层
    If TypeOf pLayer Is IRasterLayer Then
        Set pRasterLayer = pLayer
        Set pRaster = pRasterLayer.Raster

        ' Set raster property
        Dim pRasProp As IRasterProps
        Set pRasProp = pRaster

        Dim pPoint As IPoint
        Set pPoint = New Point

        Dim pSrcPoints As IPointCollection
        Dim pTarPoints As IPointCollection

        Set pSrcPoints = New Polygon
        Set pTarPoints = New Polygon

        pPoint.X = pRasProp.Extent.XMin
        pPoint.Y = pRasProp.Extent.YMin
        pSrcPoints.AddPoint pPoint

        pPoint.X = pRasProp.Extent.XMin
        pPoint.Y = pRasProp.Extent.YMax
        pSrcPoints.AddPoint pPoint

        pPoint.X = pRasProp.Extent.XMax
        pPoint.Y = pRasProp.Extent.YMax
        pSrcPoints.AddPoint pPoint

        pPoint.X = pRasProp.Extent.XMax
        pPoint.Y = pRasProp.Extent.YMin
        pSrcPoints.AddPoint pPoint

        pPoint.X = pActiveView.Extent.XMin
        pPoint.Y = pActiveView.Extent.YMin
        pTarPoints.AddPoint pPoint

        pPoint.X = pActiveView.Extent.XMin
        pPoint.Y = pActiveView.Extent.YMax
        pTarPoints.AddPoint pPoint

        pPoint.X = pActiveView.Extent.XMax
        pPoint.Y = pActiveView.Extent.YMax
        pTarPoints.AddPoint pPoint

        pPoint.X = pActiveView.Extent.XMax
        pPoint.Y = pActiveView.Extent.YMin
        pTarPoints.AddPoint pPoint




        Dim pRasterGp As IRasterGeometryProc3
        Set pRasterGp = New RasterGeometryProc


        pRasterGp.Reset pRaster
        pRasterGp.Warp pSrcPoints, pTarPoints, esriGeoTransPolyOrder1, pRaster


        pActiveView.PartialRefresh esriViewBackground, Nothing, Nothing