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: