乐筑天下

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

缩放视口

[复制链接]

170

主题

1424

帖子

8

银币

顶梁支柱

Rank: 50Rank: 50

铜币
2119
发表于 2007-3-5 14:48:49 | 显示全部楼层 |阅读模式

本帖以下内容被隐藏保护;需要你回复后,才能看到!

游客,如果您要查看本帖隐藏内容请回复
回复

使用道具 举报

170

主题

1424

帖子

8

银币

顶梁支柱

Rank: 50Rank: 50

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

使用道具 举报

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 | 显示全部楼层
布莱科,效果很好。我想我需要更多的咖啡来让大脑运转起来。
回复

使用道具 举报

170

主题

1424

帖子

8

银币

顶梁支柱

Rank: 50Rank: 50

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

使用道具 举报

170

主题

1424

帖子

8

银币

顶梁支柱

Rank: 50Rank: 50

铜币
2119
发表于 2007-3-7 08:30:43 | 显示全部楼层
如果您稍微改变一下逻辑,您可以进一步整理代码并摆脱GOTO:
  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 | 显示全部楼层
我注意到有些人不喜欢goto,我不知道为什么。
我认为它们使代码更易于阅读。
回复

使用道具 举报

170

主题

1424

帖子

8

银币

顶梁支柱

Rank: 50Rank: 50

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

使用道具 举报

发表回复

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

本版积分规则

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

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

GMT+8, 2025-7-7 13:10 , Processed in 0.508082 second(s), 72 queries .

© 2020-2025 乐筑天下

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