AE实现Geoprocessing Fit to Display

 

<script type="text/javascript"> </script><script type="text/javascript" src="http://pagead2.googlesyndication.com/pagead/show_ads.js"> </script>

将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

    End If
   
End Sub