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:
