[编程交流] 查找视口的比例-

Sub PVPortScale()
Dim strVpScaleStd As String
Dim strVpScaleCust As String
Dim Entity As AcadEntity
Dim PVport As AcadPViewport
Dim objLayout As AcadLayout
Dim i As Integer
  For Each objLayout In ThisDrawing.Layouts
     If objLayout.Name <> "Model" Then
        ThisDrawing.ActiveLayout = objLayout
       ThisDrawing.MSpace = False
        For i = 1 To objLayout.Block.Count - 1 'avoid primary Paperspace PViewport
           Set Entity = objLayout.Block.Item(i)
           If TypeOf Entity Is AcadPViewport Then
              Set PVport = Entity
              strVpScaleStd = PVport.StandardScale
              strVpScaleCust = PVport.CustomScale
              If strVpScaleCust > 0 Then
              Exit For
              End If
           End If
        Next
       End If
  Next
End Sub