Search for biggest viewport in layout

Hi,

At the moment i'm creating a routine that auto fills drawing properties.
a random drawing contains different viewport and scales. I would like VBA to serach the biggest viewport and then returns the scale.

Any Ideas, It would help a lot

Thx

Wiebe

 

[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]