有时行得通有时行不通
我被迷惑了...有时候这种代码是有效的...有时候不会...任何代码更正，使这一功能的所有时间将不胜感激。TIA:难看:Private Sub cmdChangeVPortLayer _ Click()
Dim vport As AcadPViewport
Dim ol ayout As acad layout
Dim new layer As acad layer
Set new layer = this drawing。Layers.Add("Viewport")
此绘图。ActiveLayer = newLayer。ActiveLayer.Plottable = False。active layer . color = AC green
me . hide
' On Error Resume Next
用于此绘图中的每个布局。布局
如果oLayout。然后
为oLayout中的每个vport命名“Model”。如果vport，则阻止
'将vport更改为驻留在层“视口”上。图层“视口”，然后
vport。layer = " Viewport "
Else
End If
Next ' choke
End If
Next
End Sub
**** Hidden Message ***** 很多人不知道的一件事是，纸空间本身就是一个视角... 它看起来“应该”可以工作，但当然您也可以枚举PS对象或在纸张空间中创建所有视口对象的选择集。可能存在问题的一件事是不规则形状的视口。从程序上讲，它们是被封闭多边形或圆形遮蔽的视口，可能无法识别。 我似乎记得Glenn bloke帮我解决了同样的问题。
文件空间视口总是在各个vps之前制作，因此您可以使用它的id。
Public Sub PViewportsLayer(pLayout As AcadLayout)
Dim pEnt As AcadEntity, id As Long
For Each pEnt In pLayout.Block
If TypeOf pEnt Is AcadPViewport Then
If id = 0 Then
id = pEnt.ObjectID
Else
If pEnt.ObjectID > id Then
pEnt.Layer = "Viewport"
End If
End If
End If
Next
Set pEnt = Nothing
Set pLayout = Nothing
End Sub
Sub Thang()
Dim l As AcadLayout
ThisDrawing.LAYERS.Add ("Viewport")
For Each l In ThisDrawing.Layouts
If l.ModelType = False Then
PViewportsLayer l
End If
Next
End Sub
我知道这看起来只是循环访问块中的视口，但它会遍历块中的每个事物，线条，折线，块引用，你的名字。如果块中的某些内容不是 AcadPViewport，则可能会收到错误 13，类型不匹配。
Bryco，
无法让它工作。我希望它在命令（在cmb下）而不是作为潜艇被调用。你能建议吗？
还有人能进一步吗？ 不太清楚你的意思，但是如果你从表单运行它，只需将名称从sub Thang更改为Private SubcmdChangeVPortLayer_Click（），就可以了。由于Public Sub PViewportsLayer是公共的，它可以在表单中或模块中。
不。在 ADT2005 中仍然不起作用。：realmad： 它会给你一个错误吗？我不知道
“我希望它被命令调用”到底是什么意思。
页:
[1]