[编程交流] 将vba应用于bl的子实体

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