[pre]
Option Explicit
'-------------------------------------------------------------------------------
Public Function GetLargestViewport() As AcadPViewport
Dim Entity As AcadEntity
Dim FilterData(0 To 1) As Variant
Dim FilterType(0 To 1) As Integer
Dim LargestViewport As AcadPViewport
Dim LayoutViewport As AcadPViewport
Dim MaxArea As Double
Dim SelSet As AcadSelectionSet
Dim ThisArea As Double
Dim Viewport As AcadPViewport
On Error Resume Next
ThisDrawing.SelectionSets.Item("VPORTS").Delete
On Error GoTo 0
Set SelSet = ThisDrawing.SelectionSets.Add("VPORTS")
FilterType(0) = 0
FilterData(0) = "VIEWPORT"
FilterType(1) = 69
FilterData(1) = 1
SelSet.Select acSelectionSetAll, , , FilterType, FilterData
If SelSet.Count > 0 Then
Set LayoutViewport = SelSet.Item(0)
End If
MaxArea = 0#
Set LargestViewport = Nothing
For Each Entity In ThisDrawing.PaperSpace
If TypeOf Entity Is AcadPViewport Then
Set Viewport = Entity
If Viewport.ObjectID <> LayoutViewport.ObjectID Then
ThisArea = Viewport.height * Viewport.width
If ThisArea > MaxArea Then
MaxArea = ThisArea
Set LargestViewport = Viewport
End If
End If
End If
Next Entity
Set GetLargestViewport = LargestViewport
End Function
'-------------------------------------------------------------------------------
Public Sub Test()
Dim Viewport As AcadPViewport
ThisDrawing.ActiveSpace = acPaperSpace
Set Viewport = GetLargestViewport
If Viewport Is Nothing Then
MsgBox "Error"
Else
MsgBox Viewport.CustomScale
End If
End Sub
'-------------------------------------------------------------------------------
[/pre]
