Attribute VB_Name = "modChangeAllEntInSelBlocks"
'*************************************************************
'**   autor: Harry    (c)2010                               **
'**   zmariusz@poczta.fm                                    **
'**   odwiedŸ www.vbamania.pl                               **
'**   przenoszenie wszystkich elementow w zaznaczonych      **
'**   blokach na warstwę 0 i ustawienie ich                 **
'**   Linetype = "ByLayer" i Color = "ByLayer"              **
'*************************************************************

Option Explicit

Sub ChangeAllEntInSelBlocks()
Dim oDoc As ThisDrawing
Set oDoc = ThisDrawing
Dim obj As AcadEntity
Dim oSSET As AcadSelectionSet
Dim pt As Variant
Const strSSETName As String = "SSET"
Dim msg As String
Dim i As Long: i = 1

For Each oSSET In oDoc.SelectionSets
    If oSSET.Name = strSSETName Then oSSET.Delete
Next oSSET

Set oSSET = oDoc.SelectionSets.Add(strSSETName)
oSSET.SelectOnScreen

If oSSET.Count <> 0 Then
    For Each obj In oSSET
        If obj.ObjectName = "AcDbBlockReference" Then
            ChkBlockEnt obj: i = i + 1
        End If
    Next obj
End If
msg = "Zamieniono " & i & " grup."

oSSET.Delete

Set oSSET = Nothing
Set obj = Nothing
oDoc.Regen acAllViewports
MsgBox msg
End Sub

Sub ChkBlockEnt(obj As AcadBlockReference)
Dim el As AcadEntity
For Each el In ThisDrawing.Blocks(obj.Name)
    If el.ObjectName = "AcDbBlockReference" Then
        ChkBlockEnt el
    Else
        el.Layer = "0"
        el.Linetype = "ByLayer"
        el.Color = acByLayer
    End If
Next el
End Sub