社区 › VB › 缩放视口

Bryco 发表于 2007-3-5 14:48:49

缩放视口

**** Hidden Message *****

Bryco 发表于 2007-3-5 16:49:32

您是否忽略了纸张空间视图本身？

Bryco 发表于 2007-3-5 21:19:41

我不认为你能从一个选择中到达那里。
试试这个Public Sub VPzXP2()

      Dim oLayout As AcadLayout
      Dim oLayouts As AcadLayouts
      Dim B As AcadBlock
      Dim Ent As AcadEntity
      Dim vp As AcadPViewport
      Dim N As Double
      Set oLayouts = ThisDrawing.Layouts
      For Each oLayout In oLayouts
          If UCase(oLayout.Name) = "MODEL" Then GoTo skip
          Set B = oLayout.Block
            For Each Ent In B
                If Not TypeOf Ent Is AcadPViewport Then GoTo skipEnts
                If Ent.ObjectID = B(0).ObjectID Then GoTo skipEnts
                Set vp = Ent
                If vp.DisplayLocked = True Then
                      vp.DisplayLocked = False
                End If
                ThisDrawing.ActiveLayout = oLayout
                vp.Display True
                ThisDrawing.MSpace = True
                ZoomExtents
                N = CDbl(ThisDrawing.GetVariable("DIMSCALE"))
                N = 1 / N
                ZoomScaled N, 2
                ThisDrawing.MSpace = False
                vp.DisplayLocked = True
skipEnts:
            Next Ent
skip:
    Next oLayout
End Sub

Bryco 发表于 2007-3-6 09:03:11

不，我知道我忘记了什么我能看到它激活了它，但大脑没有工作

Bryco 发表于 2007-3-6 09:06:43

布莱科，效果很好。我想我需要更多的咖啡来让大脑运转起来。

Bryco 发表于 2007-3-6 14:21:09

这一直是一种痛苦，我希望我能找到更好的方法。

Bryco 发表于 2007-3-7 08:30:43

如果您稍微改变一下逻辑，您可以进一步整理代码并摆脱GOTO：
Public Sub VPzXP2()
Dim oLayout As AcadLayout
Dim oLayouts As AcadLayouts
Dim B As AcadBlock
Dim Ent As AcadEntity
Dim vp As AcadPViewport
Dim N As Double
      
Set oLayouts = ThisDrawing.Layouts
    For Each oLayout In oLayouts
      If UCase(oLayout.Name)"MODEL" Then
          Set B = oLayout.Block
            For Each Ent In B
                If TypeOf Ent Is AcadPViewport Then
                  If Ent.ObjectIDB(0).ObjectID Then
                  Set vp = Ent
                  If vp.DisplayLocked = True Then
                        vp.DisplayLocked = False
                  End If
                  ThisDrawing.ActiveLayout = oLayout
                  vp.Display True
                  ThisDrawing.MSpace = True
                  ZoomExtents
                  N = CDbl(ThisDrawing.GetVariable("DIMSCALE"))
                  N = 1 / N
                  ZoomScaled N, 2
                  ThisDrawing.MSpace = False
                  vp.DisplayLocked = True
                  End If
                End If
            Next Ent
      End If
Next oLayout
End Sub

Bryco 发表于 2007-3-7 08:45:14

干得好DaveR每天都学东西

Bryco 发表于 2007-3-7 10:05:38

我注意到有些人不喜欢goto，我不知道为什么。
我认为它们使代码更易于阅读。

Bryco 发表于 2007-3-7 11:20:30

我认为这是因为它有可能生成意大利面条式的代码。如果使用得当，它很好，但也有人认为使用它是不好的做法。

查看完整版本: 缩放视口