[求助]识别图幅大小

  Public Function Extents(points)
       Dim min, max
       Dim i As Long, j As Long, pt, retVal(0 To 1)
       min = points(LBound(points))
       max = points(LBound(points))
       For i = LBound(points) To UBound(points)
               pt = points(i)
               For j = LBound(pt) To UBound(pt)
                       If pt(j)  max(j) Then max(j) = pt(j)
               Next
       Next
       retVal(0) = min: retVal(1) = max
       Extents = retVal
End FunctionPublic Function ssExtents(ss As AcadSelectionSet) As Variant
       Dim points(), c As Long
       Dim min, max, util As AcadUtility
       Set util = ThisDrawing.Utility
       c = 0
       For i = 0 To ss.Count - 1
               ss.Item(i).GetBoundingBox min, max
               min = util.TranslateCoordinates(min, acWorld, acUCS, False)
               max = util.TranslateCoordinates(max, acWorld, acUCS, False)
               ReDim Preserve points(0 To c + 1)
               points(c) = min: points(c + 1) = max
               c = c + 2
       Next
       ssExtents = Extents(points)
End FunctionPublic Function CreateSelectionSet(Optional ssName As String = "ss") As AcadSelectionSet
       Dim ss As AcadSelectionSet
       On Error Resume Next
       Set ss = ThisDrawing.SelectionSets(ssName)
       If Err Then Set ss = ThisDrawing.SelectionSets.Add(ssName)
       ss.Clear
       Set CreateSelectionSet = ss
End FunctionSub kr_limit()
  Dim ss As AcadSelectionSet
  Set ss = CreateSelectionSet
  ss.Select acSelectionSetAll
  Dim retVal
  retVal = ssExtents(ss)End Sub