对arcmap显示区域大小进行缩放.txt

常见的地图操作和常用的功能实现（基本功能）

对ArcMap显示区域大小进行缩放  
作者： 兔八哥  
　  

'本例用来对ArcMap显示区域进行放达2倍,修改2为你需要的放大比例
Private Sub UIButtonControl1_Click()

　　Dim pMxApp As IMxApplication
　　Dim pMxDoc As IMxDocument
　　Dim pDisp As IScreenDisplay
　　Dim pPoint As Ipoint
　　Dim pCenterPoint As Ipoint 
　　'获得当前Display
　　Set pMxApp = Application
　　Set pDisp = pMxApp.Display
　　Set pMxDoc = Document
　　'获取当前显示区域
　　Dim pCurrentEnv As Ienvelope
　　Dim pEnv As Ienvelope
　　Set pCurrentEnv = pMxDoc.ActiveView.Extent.Envelope
　　Set pEnv = pMxDoc.ActiveView.Extent.Envelope

　　'设置显示范围为当前的1/2
　　pEnv.Height = pCurrentEnv.Height / 2
　　pEnv.Width = pCurrentEnv.Width / 2

　　'设置新的显示区域的中心为原来显示区域中心
　　Set pPoint = New Point
　　Set pCenterPoint = New Point
　　pCenterPoint.X = pCurrentEnv.LowerLeft.X + pCurrentEnv.Width / 2
　　pCenterPoint.Y = pCurrentEnv.LowerLeft.Y + pCurrentEnv.Height / 2
　　pEnv.CenterAt pCenterPoint

　　'设置视图显示区域
　　pMxDoc.ActiveView.Extent = pEnv
　　pMxDoc.ActiveView.Refresh

End Sub