Use COM API/VBA to Open Viewport on Layout to Show Given Content in ModelSpace

Since I moved to AutoCAD .NET API more than 15 years ago, I dealt with AutoCAD VBA less and less, yet, still not completely left it behind. There was a recent discussion in the VBA discussion forum on the topic of opening viewport on layout to show ModelSpace content within a given area/scope. While there are a few useful replies, the OP still expects/prefers VBA code sample. According to the OP's request, the VBA code should not be too complicated, so I gave it a try. Once again, instead of posting the code sample as reply in the discussion thread, it would be better to post here with better readability.

First, let me assume the conditions of running the code:

A rectangle block is used as content boundary in the ModelSpace to be shown in a layout's viewport with given scale.

This picture shows the ModelSpace contents to be shown:

The coding process would be:

1. Determine the rectangle's size (width/height), rotation angle, and the coordinates of its corners;

2. Open a Viewport on a layout with the same size as the rectangle (scaled, of course);

3. Activate the Viewport in MSpace mode and zoom the view to the rectangle.

Note, ideally, based on the rectangle's size and required scale, the code could do calculation to decide what paper size is needed for the layout. But I omitted this calculation and simply manually chose a paper size for the layout ("Layout1") and choose the open the AcadPViewport at point (200, 150) as its center, which is based on the boundary block's size and a scale of 1/20 (0.05).

Here is the class BorderBlock, which holds all geometric information required to create the Viewport (e.g. in VBA Editor, create a class, name it as BorderBlock):

Option Explicit

Private mBlkName As String
Private mHeight As Double
Private mWidth As Double
Private mRotation As Double
Private mScale As Double
Private mLLCorner(0 To 2) As Double
Private mLRCorner(0 To 2) As Double
Private mULCorner(0 To 2) As Double
Private mURCorner(0 To 2) As Double

Private Sub Class_Initialize()
    mBlkName = "VPORT_BOUNDARY"
    mScale = 0.05
End Sub

Public Property Get VPortTweestAngle() As Double
    VPortTweestAngle = mRotation
End Property
Public Property Get Height() As Double
    Height = mHeight
End Property
Public Property Get Width() As Double
    Width = mWidth
End Property
Public Property Get VPortWidth() As Double
    VPortWidth = mWidth * mScale
End Property
Public Property Get VPortHeigth() As Double
    VPortHeigth = mHeight * mScale
End Property
Public Property Get VPortScale() As Double
    VPortScale = mScale
End Property

Public Property Get LLCorner() As Variant
    LLCorner = mLLCorner
End Property

Public Property Get URCorner() As Variant
    URCorner = mURCorner
End Property

Public Sub GetViewportData(blk As AcadBlockReference)

    '' Get border block's width and height
    Dim oldRotation As Double
    Dim minPt As Variant
    Dim maxPt As Variant
    If blk.Rotation <> 0 Then
        oldRotation = blk.Rotation
        blk.Rotation = 0#
    End If
    blk.GetBoundingBox minPt, maxPt
    mWidth = maxPt(0) - minPt(0)
    mHeight = maxPt(1) - minPt(1)
    blk.Rotation = oldRotation

    '' View port tweest angle
    mRotation = 2 * 3.1415926 - blk.Rotation
    
    '' Get 4 corners of the border block
    mLLCorner(0) = blk.InsertionPoint(0)
    mLLCorner(1) = blk.InsertionPoint(1)
    mLLCorner(2) = blk.InsertionPoint(2)
    
    Dim angle As Double
    Dim nextCorner As Variant
    
    angle = blk.Rotation
    nextCorner = CalculateNextCorner(mLLCorner, angle, mWidth)
    mLRCorner(0) = nextCorner(0)
    mLRCorner(1) = nextCorner(1)
    mLRCorner(2) = nextCorner(2)
    
    angle = angle + 3.1415926 / 2#
    nextCorner = CalculateNextCorner(mLRCorner, angle, mHeight)
    mURCorner(0) = nextCorner(0)
    mURCorner(1) = nextCorner(1)
    mURCorner(2) = nextCorner(2)
    
    angle = angle + 3.1415926 / 2#
    nextCorner = CalculateNextCorner(mURCorner, angle, mWidth)
    mULCorner(0) = nextCorner(0)
    mULCorner(1) = nextCorner(1)
    mULCorner(2) = nextCorner(2)
    
End Sub

Private Function CalculateNextCorner(corner As Variant, angle As Double, distance As Double) As Variant
    
    Dim nextCorner(0 To 2) As Double
    Dim x As Double
    Dim y As Double
    
    x = distance * Cos(angle)
    x = x + corner(0)
    
    y = distance * Sin(angle)
    y = y + corner(1)
    
    nextCorner(0) = x: nextCorner(1) = y: nextCorner(2) = corner(2)
    
    CalculateNextCorner = nextCorner
    
End Function

There is the VBA module with a public method OpenPVport() as a macro:

Option Explicit

Public Sub OpenPVport()
    
    Dim border As BorderBlock
    Set border = SelectBorderBlock()
    If border Is Nothing Then Exit Sub
    
    ThisDrawing.ActiveSpace = acPaperSpace
    ThisDrawing.ActiveLayout = ThisDrawing.Layouts("Layout1")
    
    CreatePVort border
    
End Sub

Private Function SelectBorderBlock() As BorderBlock
    If ThisDrawing.ActiveSpace <> acModelSpace Then
        ThisDrawing.ActiveSpace = acModelSpace
    End If
    Dim blk As AcadBlockReference
    Dim ent As AcadEntity
    Dim pt As Variant
    On Error Resume Next
    ThisDrawing.Utility.GetEntity ent, pt, vbCr & "Select vport boundary block:"
    If ent Is Nothing Then Exit Function
    If TypeOf ent Is AcadBlockReference Then
        Set blk = ent
        If UCase(blk.Name) <> "VPORT_BOUNDARY" Then
            MsgBox "Selected wrong block: not VPORT_BOUNDARY block!"
            Exit Function
        End If
    Else
        MsgBox "Selected entity is not a block reference!"
        Exit Function
    End If
    
    Dim border As BorderBlock
    Set border = New BorderBlock
    border.GetViewportData blk
    Set SelectBorderBlock = border
End Function

Private Sub CreatePVort(border As BorderBlock)

    Dim vport As AcadPViewport
    Dim center(0 To 2) As Double
    center(0) = 200: center(1) = 150: center(2) = 0
    Set vport = ThisDrawing.PaperSpace.AddPViewport( _
        center, border.VPortWidth, border.VPortHeigth)
    vport.Display True
    vport.TwistAngle = border.VPortTweestAngle
    
    '' zoom properly
    ThisDrawing.MSpace = True
    ThisDrawing.ActivePViewport = vport
    ThisDrawing.MSpace = True
    ZoomWindow border.LLCorner, border.URCorner
    ThisDrawing.MSpace = False
    
    '' Lock the viewport's display
    vport.DisplayLocked = True
    vport.Update
      
End Sub

See following video clip for the action of the code: