Imports System
Imports System.Runtime.InteropServices
Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.EditorInput
<Assembly: CommandClass(GetType(Rivilis.CreateViewport))>
Namespace Rivilis
Public Class CreateViewport
<DllImport("accore.dll", CallingConvention:=CallingConvention.Cdecl, _
EntryPoint:="?acedSetCurrentVPort@@YA?AW4ErrorStatus@Acad@@PBVAcDbViewport@@@Z")> _
Public Shared Function acedSetCurrentVPort32(ByVal AcDbVport As IntPtr) As IntPtr
End Function
<DllImport("accore.dll", CallingConvention:=CallingConvention.Cdecl, _
EntryPoint:="?acedSetCurrentVPort@@YA?AW4ErrorStatus@Acad@@PEBVAcDbViewport@@@Z")> _
Public Shared Function acedSetCurrentVPort64(ByVal AcDbVport As IntPtr) As IntPtr
End Function
Public Function acedSetCurrentVPort(ByVal vport As IntPtr) As IntPtr
If (IntPtr.Size = 4) Then
Return acedSetCurrentVPort32(vport)
Else
Return acedSetCurrentVPort64(vport)
End If
End Function
<CommandMethod("CreateVP")> _
Public Sub CreateFloatingViewport()
'' Get the current document and database, and start a transaction
Dim acDoc As Document = Application.DocumentManager.MdiActiveDocument
Dim acCurDb As Database = acDoc.Database
Using acTrans As Transaction = acCurDb.TransactionManager.StartTransaction()
'' Open the Block table for read
Dim acBlkTbl As BlockTable
acBlkTbl = acTrans.GetObject(acCurDb.BlockTableId, _
OpenMode.ForRead)
'' Open the Block table record Paper space for write
Dim acBlkTblRec As BlockTableRecord
acBlkTblRec = acTrans.GetObject(acBlkTbl(BlockTableRecord.PaperSpace), _
OpenMode.ForWrite)
'' Switch to the previous Paper space layout
Application.SetSystemVariable("TILEMODE", 0)
acDoc.Editor.SwitchToPaperSpace()
'' Create a Viewport
Dim vp As Viewport = New Viewport()
vp.SetDatabaseDefaults()
vp.CenterPoint = New Point3d(50, 50, 0)
vp.Width = 100
vp.Height = 100
'' Add the new object to the block table record and the transaction
acBlkTblRec.AppendEntity(vp)
acTrans.AddNewlyCreatedDBObject(vp, True)
'' Change the view direction
vp.ViewDirection = New Vector3d(0, 0, 1)
'' Enable the viewport
vp.On = True
'' Activate model space in the viewport
acDoc.Editor.SwitchToModelSpace()
'' Set the new viewport current via an imported ObjectARX function
acedSetCurrentVPort(vp.UnmanagedObject)
'' Save the new objects to the database
Dim mScrRatio As Double
mScrRatio = (vp.Width / vp.Height)
Dim mMaxExt As Point3d : mMaxExt = acCurDb.Extmax
Dim mMinExt As Point3d : mMinExt = acCurDb.Extmin
Dim mExtents As Extents3d = New Extents3d()
mExtents.Set(mMinExt, mMaxExt)
'' prepare Matrix for DCS to WCS transformation
Dim matWCS2DCS As Matrix3d
matWCS2DCS = Matrix3d.PlaneToWorld(vp.ViewDirection)
matWCS2DCS = Matrix3d.Displacement(vp.ViewTarget - Point3d.Origin) * matWCS2DCS
matWCS2DCS = Matrix3d.Rotation(-vp.TwistAngle, vp.ViewDirection, vp.ViewTarget) * matWCS2DCS
matWCS2DCS = matWCS2DCS.Inverse()
'' tranform the extents to the DCS
'' defined by the viewdir
mExtents.TransformBy(matWCS2DCS)
'' width of the extents in current view
Dim mWidth As Double
mWidth = (mExtents.MaxPoint.X - mExtents.MinPoint.X)
'' height of the extents in current view
Dim mHeight As Double
mHeight = (mExtents.MaxPoint.Y - mExtents.MinPoint.Y)
'' get the view center point
Dim mCentPt As Point2d
mCentPt = New Point2d( _
((mExtents.MaxPoint.X + mExtents.MinPoint.X) * 0.5), _
((mExtents.MaxPoint.Y + mExtents.MinPoint.Y) * 0.5) _
)
'' check if the width 'fits' in current window,
'' if not then get the new height as
'' per the viewports aspect ratio
If (mWidth > (mHeight * mScrRatio)) Then
mHeight = mWidth / mScrRatio
End If
'' set the viewport parameters
vp.UpgradeOpen()
'' set the view height - adjusted by 1%
vp.ViewHeight = mHeight * 1.01
'' set the view center
vp.ViewCenter = mCentPt
vp.Visible = True
vp.On = True
vp.UpdateDisplay()
acDoc.Editor.SwitchToModelSpace()
Application.SetSystemVariable("CVPORT", vp.Number)
acTrans.Commit()
End Using
End Sub
End Class
End Namespace