乐筑天下

搜索
欢迎各位开发者和用户入驻本平台 尊重版权,从我做起,拒绝盗版,拒绝倒卖 签到、发布资源、邀请好友注册,可以获得银币 请注意保管好自己的密码,避免账户资金被盗
查看: 232|回复: 13

缩放视口

[复制链接]

170

主题

1424

帖子

8

银币

顶梁支柱

Rank: 50Rank: 50

铜币
2119
发表于 2007-3-5 14:48:49 | 显示全部楼层 |阅读模式
好的,可能只是星期一,但我无法让这段代码工作
  1. Public Sub VPzXP()
  2.       On Error GoTo ERR_CONTROL
  3.       Dim vp As AcadPViewport
  4.       Dim N As Double
  5.       Dim gpCode(0) As Integer
  6.       Dim dataValue(0) As Variant
  7.       Dim OBJSELSET As AcadSelectionSet
  8.       gpCode(0) = 0
  9.       dataValue(0) = "VIEWPORT"
  10.       Set OBJSELSET = ThisDrawing.SelectionSets.Add("VPL")
  11.       OBJSELSET.Select acSelectionSetAll, , , gpCode, dataValue
  12.       
  13.       For Each vp In OBJSELSET
  14.             If vp.DisplayLocked = True Then
  15.                   vp.DisplayLocked = False
  16.             End If
  17.             ThisDrawing.MSpace = True
  18.             ZoomExtents
  19.             N = CDbl(ThisDrawing.GetVariable("DIMSCALE"))
  20.             N = 1 / N
  21.             ZoomScaled N, 2
  22.             ThisDrawing.MSpace = False
  23.             vp.DisplayLocked = True
  24.          Next
  25. Exit_Here:
  26.       Exit Sub
  27. ERR_CONTROL:
  28.       Select Case Err.Number
  29.             Case "-2145320851"
  30.                   ThisDrawing.SelectionSets.Item("VPL").Delete
  31.                   Err.Clear
  32.                   Resume
  33.             Case Else
  34.                   MsgBox Err.Number
  35.                   Err.Clear
  36.                   Resume Exit_Here
  37.       End Select
  38. End Sub

如果我单步执行,它在第一次通过时有效,但Acad希望再次处理VP,并缩放范围,然后退出
有人知道为什么吗?
回复

使用道具 举报

170

主题

1424

帖子

8

银币

顶梁支柱

Rank: 50Rank: 50

铜币
2119
发表于 2007-3-5 16:49:32 | 显示全部楼层
您是否忽略了Paperspace视口本身?
回复

使用道具 举报

170

主题

1424

帖子

8

银币

顶梁支柱

Rank: 50Rank: 50

铜币
2119
发表于 2007-3-5 21:19:41 | 显示全部楼层
我不知道'我不认为你可以通过选择集到达那里
试试这个
  1. Public Sub VPzXP2()
  2.   
  3.       Dim oLayout As AcadLayout
  4.       Dim oLayouts As AcadLayouts
  5.       Dim B As AcadBlock
  6.       Dim Ent As AcadEntity
  7.       Dim vp As AcadPViewport
  8.       Dim N As Double
  9.       Set oLayouts = ThisDrawing.Layouts
  10.       For Each oLayout In oLayouts
  11.           If UCase(oLayout.Name) = "MODEL" Then GoTo skip
  12.           Set B = oLayout.Block
  13.             For Each Ent In B
  14.                 If Not TypeOf Ent Is AcadPViewport Then GoTo skipEnts
  15.                 If Ent.ObjectID = B(0).ObjectID Then GoTo skipEnts
  16.                 Set vp = Ent
  17.                 If vp.DisplayLocked = True Then
  18.                       vp.DisplayLocked = False
  19.                 End If
  20.                 ThisDrawing.ActiveLayout = oLayout
  21.                 vp.Display True
  22.                 ThisDrawing.MSpace = True
  23.                 ZoomExtents
  24.                 N = CDbl(ThisDrawing.GetVariable("DIMSCALE"))
  25.                 N = 1 / N
  26.                 ZoomScaled N, 2
  27.                 ThisDrawing.MSpace = False
  28.                 vp.DisplayLocked = True
  29. skipEnts:
  30.             Next Ent
  31. skip:
  32.     Next oLayout
  33. End Sub
回复

使用道具 举报

170

主题

1424

帖子

8

银币

顶梁支柱

Rank: 50Rank: 50

铜币
2119
发表于 2007-3-6 09:03:11 | 显示全部楼层
不,我知道我忘了什么 我可以看到它激活了它,但大脑没有工作
回复

使用道具 举报

170

主题

1424

帖子

8

银币

顶梁支柱

Rank: 50Rank: 50

铜币
2119
发表于 2007-3-6 09:06:43 | 显示全部楼层
Bryco,很好 我想我需要更多的咖啡来让大脑运转起来。
回复

使用道具 举报

170

主题

1424

帖子

8

银币

顶梁支柱

Rank: 50Rank: 50

铜币
2119
发表于 2007-3-6 14:21:09 | 显示全部楼层
It#039;这一直是一种痛苦,我希望我能找到更好的方法。
回复

使用道具 举报

170

主题

1424

帖子

8

银币

顶梁支柱

Rank: 50Rank: 50

铜币
2119
发表于 2007-3-7 08:30:43 | 显示全部楼层
如果稍微更改一下逻辑,您可以进一步整理代码并去掉GOTOs:
  1. Public Sub VPzXP2()
  2.   Dim oLayout As AcadLayout
  3.   Dim oLayouts As AcadLayouts
  4.   Dim B As AcadBlock
  5.   Dim Ent As AcadEntity
  6.   Dim vp As AcadPViewport
  7.   Dim N As Double
  8.       
  9.   Set oLayouts = ThisDrawing.Layouts
  10.     For Each oLayout In oLayouts
  11.         If UCase(oLayout.Name)  "MODEL" Then
  12.           Set B = oLayout.Block
  13.             For Each Ent In B
  14.                 If TypeOf Ent Is AcadPViewport Then
  15.                   If Ent.ObjectID  B(0).ObjectID Then
  16.                     Set vp = Ent
  17.                     If vp.DisplayLocked = True Then
  18.                           vp.DisplayLocked = False
  19.                     End If
  20.                     ThisDrawing.ActiveLayout = oLayout
  21.                     vp.Display True
  22.                     ThisDrawing.MSpace = True
  23.                     ZoomExtents
  24.                     N = CDbl(ThisDrawing.GetVariable("DIMSCALE"))
  25.                     N = 1 / N
  26.                     ZoomScaled N, 2
  27.                     ThisDrawing.MSpace = False
  28.                     vp.DisplayLocked = True
  29.                   End If
  30.                 End If
  31.             Next Ent
  32.         End If
  33.   Next oLayout
  34. End Sub
回复

使用道具 举报

170

主题

1424

帖子

8

银币

顶梁支柱

Rank: 50Rank: 50

铜币
2119
发表于 2007-3-7 08:45:14 | 显示全部楼层
干得好DaveR 每天学点东西
回复

使用道具 举报

170

主题

1424

帖子

8

银币

顶梁支柱

Rank: 50Rank: 50

铜币
2119
发表于 2007-3-7 10:05:38 | 显示全部楼层
本人'我注意到有些人不't喜欢goto,I'我不知道为什么
我认为它们使代码更容易阅读。
回复

使用道具 举报

170

主题

1424

帖子

8

银币

顶梁支柱

Rank: 50Rank: 50

铜币
2119
发表于 2007-3-7 11:20:30 | 显示全部楼层
我认为原因是它有潜力制作意大利面代码 如果使用得当,这很好,但也有人认为使用它是不好的做法。
回复

使用道具 举报

发表回复

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

QQ|关于我们|小黑屋|乐筑天下 繁体中文

GMT+8, 2025-7-7 13:50 , Processed in 0.738460 second(s), 73 queries .

© 2020-2025 乐筑天下

联系客服 关注微信 帮助中心 下载APP 返回顶部 返回列表