CAD VBA 图层管理
'图层隐藏
Sub LayHide()
On Error Resume Next
' 创建新的选择集
Dim SSet As AcadSelectionSet
Set SSet = ThisDrawing.SelectionSets.Add("SS1")
' 提示用户选择对象
' 并将其添加到选择集中。
' 要完成选择,请按回车键。
SSet.SelectOnScreen
Dim E As AcadEntity
For Each E In SSet
ThisDrawing.Layers.item(E.Layer).LayerOn = False
Next
ThisDrawing.SelectionSets.item("SS1").Delete
End Sub
'图层孤立
Sub LayIso()
On Error Resume Next
' 创建新的选择集
Dim SSet As AcadSelectionSet
Set SSet = ThisDrawing.SelectionSets.Add("SS1")
' 提示用户选择对象
' 并将其添加到选择集中。
' 要完成选择,请按回车键。
SSet.SelectOnScreen
Dim Layer As AcadLayer
For Each Layer In ThisDrawing.Layers
Layer.LayerOn = False
Next
Dim E As AcadEntity
For Each E In SSet
ThisDrawing.Layers.item(E.Layer).LayerOn = True
Next
ThisDrawing.SelectionSets.item("SS1").Delete
End Sub
'图层孤立1(PKPM钢筋图层)
Sub LayIso1()
On Error Resume Next
Dim Layer As AcadLayer
For Each Layer In ThisDrawing.Layers
Layer.LayerOn = False
Next
ThisDrawing.Layers("垂直标注").LayerOn = True
ThisDrawing.Layers("水平标注").LayerOn = True
ThisDrawing.Layers("垂直钢筋").LayerOn = True
ThisDrawing.Layers("水平钢筋").LayerOn = True
ThisDrawing.Layers("柱__钢筋标注").LayerOn = True
ThisDrawing.Layers("柱__钢筋标注").LayerOn = True
ThisDrawing.Layers("板底钢筋标注").LayerOn = True
ThisDrawing.Layers("支座钢筋标注").LayerOn = True
ThisDrawing.Layers("板底钢筋").LayerOn = True
ThisDrawing.Layers("支座钢筋").LayerOn = True
End Sub
'图层全部显示
Sub LayAllOn()
Dim Layer As AcadLayer
For Each Layer In ThisDrawing.Layers
Layer.LayerOn = True
Next
End Sub
Sub LayHide()
On Error Resume Next
' 创建新的选择集
Dim SSet As AcadSelectionSet
Set SSet = ThisDrawing.SelectionSets.Add("SS1")
' 提示用户选择对象
' 并将其添加到选择集中。
' 要完成选择,请按回车键。
SSet.SelectOnScreen
Dim E As AcadEntity
For Each E In SSet
ThisDrawing.Layers.item(E.Layer).LayerOn = False
Next
ThisDrawing.SelectionSets.item("SS1").Delete
End Sub
'图层孤立
Sub LayIso()
On Error Resume Next
' 创建新的选择集
Dim SSet As AcadSelectionSet
Set SSet = ThisDrawing.SelectionSets.Add("SS1")
' 提示用户选择对象
' 并将其添加到选择集中。
' 要完成选择,请按回车键。
SSet.SelectOnScreen
Dim Layer As AcadLayer
For Each Layer In ThisDrawing.Layers
Layer.LayerOn = False
Next
Dim E As AcadEntity
For Each E In SSet
ThisDrawing.Layers.item(E.Layer).LayerOn = True
Next
ThisDrawing.SelectionSets.item("SS1").Delete
End Sub
'图层孤立1(PKPM钢筋图层)
Sub LayIso1()
On Error Resume Next
Dim Layer As AcadLayer
For Each Layer In ThisDrawing.Layers
Layer.LayerOn = False
Next
ThisDrawing.Layers("垂直标注").LayerOn = True
ThisDrawing.Layers("水平标注").LayerOn = True
ThisDrawing.Layers("垂直钢筋").LayerOn = True
ThisDrawing.Layers("水平钢筋").LayerOn = True
ThisDrawing.Layers("柱__钢筋标注").LayerOn = True
ThisDrawing.Layers("柱__钢筋标注").LayerOn = True
ThisDrawing.Layers("板底钢筋标注").LayerOn = True
ThisDrawing.Layers("支座钢筋标注").LayerOn = True
ThisDrawing.Layers("板底钢筋").LayerOn = True
ThisDrawing.Layers("支座钢筋").LayerOn = True
End Sub
'图层全部显示
Sub LayAllOn()
Dim Layer As AcadLayer
For Each Layer In ThisDrawing.Layers
Layer.LayerOn = True
Next
End Sub
|
暂时没有评论
发表评论 - 不要忘了输入验证码哦! |