Merge Layers

Does anyone have any code that will merge layers (similar to the Express
Tools LAYMRG command)?

I've got this nugget of code (see below), and I can't remember who posted it
or where I got it, but it will merge entities from one layer to another but
it doesn't work on layers nested in blocks.

Public Const LAYER = 8 'by layer

Public Sub EntitiesOnLayer(oldLayerName As String, newLayerName As String)
Dim ent As AcadEntity
Dim objSS As AcadSelectionSet
On Error Resume Next
'delete any previous selection set
ThisDrawing.SelectionSets("Entities").Delete
'create our new selection set
Set objSS = ThisDrawing.SelectionSets.Add("Entities")
'get the actual entities for the selection set
CreateSelectionSet objSS, LAYER, oldLayerName
For Each ent In objSS
ent.LAYER = newLayerName
Next
End Sub

Public Function CreateSelectionSet(SelectionSet As AcadSelectionSet,
FilterCode As Integer, FilterValue As String) As Boolean
Dim iFilterCode(0) As Integer
Dim vFilterValue(0) As Variant

iFilterCode(0) = FilterCode
vFilterValue(0) = FilterValue

SelectionSet.Select acSelectionSetAll, , , iFilterCode, vFilterValue
'SelectionSet.SelectOnScreen intFilterCode, varFilterValue

If SelectionSet.Count Then
CreateSelectionSet = True
End If
End Function


Thanks in advance!

 

I believe you'll need to iterate through each block in the blocks
collection and change the entities that make up blocks.

 

Thanks Tim.
I'll have to rip the dialog box out of it so that it's faster, but at least
I don't have to write the code.

Thanks again!

 

No problem, happy to help.

Tim