This should get you started...it centers a particular coordinate in the drawing window or inside of a viewport, emulating a zoomcenter.
I'm planning to create a zoom class that duplicates the Application.Zooms from COM but do not have the time right now. I had this code partially completed from an OEM project I am working on. It is not the cleanest but should be OK.
Please note that there are DLLImport statements missing from the web version of the discussion group. Been a while since I've done html and forgot the syntax to force them to show...any help here???
Imports System.Runtime.InteropServices
Imports AcadApp = Autodesk.AutoCAD.ApplicationServices.Application
Imports AcAp = Autodesk.AutoCAD.ApplicationServices
Imports AcCm = Autodesk.AutoCAD.Colors
Imports AcDb = Autodesk.AutoCAD.DatabaseServices
Imports AcEd = Autodesk.AutoCAD.EditorInput
Imports AcGe = Autodesk.AutoCAD.Geometry
Imports AcGi = Autodesk.AutoCAD.GraphicsInterface
Imports AcLy = Autodesk.AutoCAD.LayerManager
Imports AcPl = Autodesk.AutoCAD.PlottingServices
Imports AcPu = Autodesk.AutoCAD.Publishing
Imports AcRx = Autodesk.AutoCAD.Runtime
Imports AcWi = Autodesk.AutoCAD.Windows
Public Class Zoom
*LessThan*DllImport("acad.exe", CallingConvention:=CallingConvention.Cdecl, EntryPoint:="?acedVportTableRecords2Vports@@YA?AW4ErrorStatus@Acad@@XZ")*GreaterThan* _
Private Shared Function acedVportTableRecords2Vports() As Boolean
End Function
*LessThan*DllImport("acad.exe", CallingConvention:=CallingConvention.Cdecl, EntryPoint:="?acedVports2VportTableRecords@@YA?AW4ErrorStatus@Acad@@XZ")*GreaterThan* _
Private Shared Function acedVports2VportTableRecords() As Boolean
End Function
*LessThan*DllImport("acad.exe", CallingConvention:=CallingConvention.Cdecl, EntryPoint:="?acedSetCurrentView@@YA?AW4ErrorStatus@Acad@@PAVAcDbViewTableRecord@@PAVAcDbViewport@@@Z")*GreaterThan* _
Public Shared Function acedSetCurrentView(ByVal viewTableRec As IntPtr, ByVal viewport As IntPtr) As IntPtr
End Function
*LessThan*AcRx.CommandMethod("ZC")*GreaterThan* _
Public Sub Center()
'The following line would need to be called if running function
'from inside of application context
'Dim DL As AcAp.DocumentLock = AcadApp.DocumentManager.MdiActiveDocument.LockDocument(AcAp.DocumentLockMode.Write, "CrosshairAlignmentMagLevel", "CrosshairAlignmentMagLevel", True)
Dim DB As AcDb.Database = AcadApp.DocumentManager.MdiActiveDocument.Database
Dim myT As AcDb.Transaction = DB.TransactionManager.StartTransaction
Try
Dim Ed As AcEd.Editor = AcadApp.DocumentManager.MdiActiveDocument.Editor
Dim PPO As New AcEd.PromptPointOptions("Select a point: ")
Dim PPR As AcEd.PromptPointResult = Nothing
PPR = Ed.GetPoint(PPO)
If PPR.Status <> Autodesk.AutoCAD.EditorInput.PromptStatus.OK Then
myT.Dispose()
Return
End If
Dim NewCenterPoint3D As AcGe.Point3d = PPR.Value
'Must convert the 3D coordinate to 2D
Dim NewCenterPoint2D As New AcGe.Point2d(NewCenterPoint3D.X, NewCenterPoint3D.Y)
If DB.TileMode = True Then
'In Modelspace
'You must first force the Vport information to the record objects or you will
'be getting stale information.
acedVports2VportTableRecords()
Dim VPTR As AcDb.ViewportTableRecord = Nothing
Dim VPT As AcDb.ViewportTable = myT.GetObject(DB.ViewportTableId, AcDb.OpenMode.ForRead)
For Each OID As AcDb.ObjectId In VPT
If OID.IsErased = False Then
'The first unerased viewport should be the current one!
VPTR = myT.GetObject(OID, Autodesk.AutoCAD.DatabaseServices.OpenMode.ForRead)
Exit For
End If
Next
VPT.Dispose()
If VPTR Is Nothing Then
myT.Dispose()
Return
End If
Dim V As New AcDb.ViewTableRecord
V.IsPaperspaceView = False
V.Height = VPTR.Height
V.Width = VPTR.Width
V.CenterPoint = NewCenterPoint2D
acedSetCurrentView(V.UnmanagedObject, Nothing)
VPTR.Dispose()
V.Dispose()
Else
'In paperspace or a floating modelspace viewport
'
'Unlike modelspace PAPERSPACE is an AcDbViewport
'not an AcDbViewportTableRecord
Dim PSVport As AcDb.Viewport
PSVport = myT.GetObject(Ed.CurrentViewportObjectId, Autodesk.AutoCAD.DatabaseServices.OpenMode.ForWrite)
PSVport.ViewCenter = NewCenterPoint2D
End If
myT.Commit()
Catch ex As Exception
AcadApp.ShowAlertDialog(ex.ToString)
Finally
myT.Dispose()
End Try
'Dispose of the lock if it was required
'DL.Dispose()
AcadApp.UpdateScreen()
End Sub
Public Sub Window()
End Sub
Public Sub Extents()
End Sub
Public Sub Entity()
End Sub
End Class
Message was edited by: rwilkins
Message was edited by: rwilkins
Ronnie Wilkins, Jr.