缩放视口

Private Sub MakeSomeObjects()
    Dim i As Integer, j As Integer
    Dim X As Integer, Y As Integer
    Dim c As AcadCircle
    Dim R As Double
    Dim Cen(2) As Double
    Dim L As AcadLayer
    Dim Ls As AcadLayers
    
    Set Ls = ThisDrawing.LAYERS
    For i = 1 To 90
        Set L = Ls.Add(i)
        L.Color = i
    Next
       
    R = 0.45
    For j = 0 To 1000
        For i = 0 To 89
            R = R + 0.001
            If Int(i / 10) = i / 10 Then
                X = 0: Y = Y + 1
            Else
                X = X + 1
            End If
            Cen(0) = X: Cen(1) = Y
            Set c = ThisDrawing.ModelSpace.AddCircle(Cen, R)
            c.Layer = i + 1
        Next i
    Next j
End Sub
Private Sub Addemup()
    Dim i As Integer
    Dim nogo As Single
    Dim go As Single
    For i = 1 To 10
        go = go + speedGoto
        nogo = nogo + speedNoGoto
    Next
    Debug.Print "nogo=" & nogo
    Debug.Print "go=" & go
End Sub
Private Function speedNoGoto() As Single
    Dim Ent As AcadEntity
    Dim T As Single
    T = Timer
    For Each Ent In ThisDrawing.ModelSpace
        If TypeOf Ent Is AcadCircle Then
            If Ent.Layer = "90" Then
                If Ent.radius > 90 Then
                    If Ent.radius  "90" Then GoTo skip
        If Ent.radius  90.5 Then GoTo skip
        
        Debug.Print Ent.radius
        Exit For
skip:
    Next Ent
    speedGoto = Timer - T
End Function