Public Shared Sub ZoomWindow(_pMin As Point3d, _pMax As Point3d)
'' Zoom to a window
Zoom(_pMin, _pMax, New Point3d(), 1)
End Sub
Shared Sub Zoom(ByVal pMin As Point3d, ByVal pMax As Point3d, ByVal pCenter As Point3d, ByVal dFactor As Double)
'' Get the current document and database
Dim acDoc As Document = Application.DocumentManager.MdiActiveDocument
Dim acCurDb As Database = acDoc.Database
Dim nCurVport As Integer = System.Convert.ToInt32(Application.GetSystemVariable("CVPORT"))
'' Get the extents of the current space when no points
'' or only a center point is provided
'' Check to see if Model space is current
If acCurDb.TileMode = True Then
If pMin.Equals(New Point3d()) = True And pMax.Equals(New Point3d()) = True Then
pMin = acCurDb.Extmin
pMax = acCurDb.Extmax
End If
Else
'' Check to see if Paper space is current
If nCurVport = 1 Then
If pMin.Equals(New Point3d()) = True And pMax.Equals(New Point3d()) = True Then
pMin = acCurDb.Pextmin
pMax = acCurDb.Pextmax
End If
Else
'' Get the extents of Model space
If pMin.Equals(New Point3d()) = True And pMax.Equals(New Point3d()) = True Then
pMin = acCurDb.Extmin
pMax = acCurDb.Extmax
End If
End If
End If
'' Start a transaction
Using acTrans As Transaction = acCurDb.TransactionManager.StartTransaction()
'' Get the current view
Using acView As ViewTableRecord = acDoc.Editor.GetCurrentView()
Dim eExtents As Extents3d
'' Translate WCS coordinates to DCS
Dim matWCS2DCS As Matrix3d
matWCS2DCS = Matrix3d.PlaneToWorld(acView.ViewDirection)
matWCS2DCS = Matrix3d.Displacement(acView.Target - Point3d.Origin) * matWCS2DCS
matWCS2DCS = Matrix3d.Rotation(-acView.ViewTwist, acView.ViewDirection, acView.Target) * matWCS2DCS
'' If a center point is specified, define the
'' min and max point of the extents
'' for Center and Scale modes
If pCenter.DistanceTo(Point3d.Origin) <> 0 Then
pMin = New Point3d(pCenter.X - (acView.Width / 2), pCenter.Y - (acView.Height / 2), 0)
pMax = New Point3d((acView.Width / 2) + pCenter.X, (acView.Height / 2) + pCenter.Y, 0)
End If
'' Create an extents object using a line
Using acLine As Autodesk.AutoCAD.DatabaseServices.Line = New Line(pMin, pMax)
eExtents = New Extents3d(acLine.StartPoint, acLine.EndPoint) 'Extents3d(acLine.Bounds.Value.MinPoint, acLine.Bounds.Value.MaxPoint)
End Using
'' Calculate the ratio between the width and height of the current view
Dim dViewRatio As Double
dViewRatio = (acView.Width / acView.Height)
'' Tranform the extents of the view
matWCS2DCS = matWCS2DCS.Inverse()
eExtents.TransformBy(matWCS2DCS)
Dim dWidth As Double
Dim dHeight As Double
Dim pNewCentPt As Point2d
'' Check to see if a center point was provided (Center and Scale modes)
If pCenter.DistanceTo(Point3d.Origin) <> 0 Then
dWidth = acView.Width
dHeight = acView.Height
If dFactor = 0 Then
pCenter = pCenter.TransformBy(matWCS2DCS)
End If
pNewCentPt = New Point2d(pCenter.X, pCenter.Y)
Else '' Working in Window, Extents and Limits mode
'' Calculate the new width and height of the current view
dWidth = eExtents.MaxPoint.X - eExtents.MinPoint.X
dHeight = eExtents.MaxPoint.Y - eExtents.MinPoint.Y
'' Get the center of the view
pNewCentPt = New Point2d(((eExtents.MaxPoint.X + eExtents.MinPoint.X) * 0.5), ((eExtents.MaxPoint.Y + eExtents.MinPoint.Y) * 0.5))
End If
'' Check to see if the new width fits in current window
If dWidth > (dHeight * dViewRatio) Then dHeight = dWidth / dViewRatio
'' Resize and scale the view
If dFactor <> 0 Then
acView.Height = dHeight * dFactor
acView.Width = dWidth * dFactor
End If
'' Set the center of the view
acView.CenterPoint = pNewCentPt
'' Set the current view
acDoc.Editor.SetCurrentView(acView)
End Using
'' Commit the changes
acTrans.Commit()
End Using
End Sub