Sub ZoomExtents(ByVal myDB As Autodesk.AutoCAD.DatabaseServices.Database) Dim tm As Autodesk.AutoCAD.DatabaseServices.Transaction = myDB.TransactionManager.StartTransaction Try If myDB.TileMode = True Then 'Model Dim vpt As ViewportTable = tm.GetObject(myDB.ViewportTableId, OpenMode.ForRead) Dim vptr As ViewportTableRecord = tm.GetObject(vpt.Item("*Active"), OpenMode.ForWrite) Dim pt3Max As Point3d = myDB.Extmax Dim pt3Min As Point3d = myDB.Extmin Dim pt2Max As Autodesk.AutoCAD.Geometry.Point2d = New Autodesk.AutoCAD.Geometry.Point2d(pt3Max.X, pt3Max.Y) Dim pt2Min As Autodesk.AutoCAD.Geometry.Point2d = New Autodesk.AutoCAD.Geometry.Point2d(pt3Min.X, pt3Min.Y) vptr.CenterPoint = (pt2Min + (pt2Max - pt2Min) / 2.0) vptr.Height = (pt2Max.Y - pt2Min.Y) vptr.Width = (pt2Max.X - pt2Min.X) myDB.UpdateExt(True) Else 'Papier End If Catch ex As Exception MsgBox("Erreur de zoom, " & ex.Message) Finally tm.Commit() tm.Dispose() End Try End Sub