将vba应用于bl的子实体
我有一个vba宏，用于将bylayer颜色应用于bylayer颜色的对象但它不适用于区块子实体
我希望有人可以修改vba代码以应用于块和嵌套块
Public Sub ColorToEntity()
'This subroutine sets each entities color from ByLayer
'to the color of the layer it's on.
Dim sset As AcadSelectionSet
Set sset = ThisDrawing.SelectionSets.Add("SS1")
' Prompt the user to select objects
' and add them to the selection set.
sset.SelectOnScreen
' Step through the selected objects and change
' each object's color to Green
Dim objEntity As AcadEntity
Dim objMS As AcadModelSpace
Dim objPS As AcadPaperSpace
Dim objLayers As AcadLayers
Dim objLayer As AcadLayer
Dim strLayer As String
Set objMS = ThisDrawing.ModelSpace
Set objPS = ThisDrawing.PaperSpace
Set objLayers = ThisDrawing.Layers
'process ents in modelspace
For Each objEntity In objMS
strLayer = objEntity.Layer
Set objLayer = objLayers.Item(strLayer)
objEntity.color = objLayer.color
Next objEntity
'process ents in paperspace
For Each objEntity In objPS
strLayer = objEntity.Layer
Set objLayer = objLayers.Item(strLayer)
objEntity.color = objLayer.color
Next objEntity
' Remove the selection set at the end
sset.Delete
End Sub
页:
[1]