Merge Layer

[gilseorin]

Hi,all.
Is it possible to merge all the layer to the layer "MyLayer"?
Some help?
Thanks in advance.

[Anonymous]

have you tried LAYMRG command?

in 2007, this is a standard command, in previous versions it was part of a
separate install called Express Tools (or Bonus Tools).

--
Melanie Perry
***not all who wander are lost***
http://mistressofthedorkness.blogspot.com/

wrote in message news:5452072@discussion.autodesk.com...
Hi,all.
Is it possible to merge all the layer to the layer "MyLayer"?
Some help?
Thanks in advance.

[gilseorin]

Yes, I already know about that.
But, what I intend to is programatically proceed the method of
merging. Thanks for the reply.

[gilseorin]

The following code is equivalent of merging layer written with VBA.

Sub MergeLayers()
Dialog1.Show
End Sub

Private Sub CancelButton_Click()

End
'ends program

End Sub

Private Sub MergeButton_Click()
Dim BlkCol As Object
Dim BlkObj As Object
Dim Obj As Object
Dim Lay As Object
Dim AttObj As Variant
Dim item As Object
Dim FromLay As String
Dim ToLay As String
Dim reLay As Object
Dim I As Integer
Dim intCount As Integer


FromLay = FromLayerList.Text
ToLay = ToLayerList.Text
Set Lay = ThisDrawing.Layers(FromLay)
Set BlkCol = ThisDrawing.Blocks
For Each BlkObj In BlkCol
If BlkObj.IsLayout = True Then
For Each Obj In BlkObj
If Obj.ObjectName = "AcDbBlockReference" Then
If Obj.HasAttributes = True Then
AttObj = Obj.GetAttributes
For I = LBound(AttObj) To UBound(AttObj)
If AttObj(I).Layer = FromLay Then
AttObj(I).Layer = ToLay
End If
Next
AttObj = Obj.GetConstantAttributes
For I = LBound(AttObj) To UBound(AttObj)
If AttObj(I).Layer = FromLay Then
AttObj(I).Layer = ToLay
End If
Next
End If
End If
If Obj.Layer = FromLay Then
Obj.Layer = ToLay
End If
Next
Else
For Each item In BlkObj
If item.Layer = FromLay Then
item.Layer = ToLay
End If
Next
End If
Next


If FromLay <> ToLay Then
If FromLay <> "0" Then
Lay.Delete
End If
End If

intCount = FromLayerList.ListCount - 1
For I = intCount To 0 Step -1
If FromLayerList.Selected(I) = True Then
FromLayerList.RemoveItem I
End If
Next

'ThisDrawing.Regen

End Sub

Private Sub UserForm_Initialize()
Dim Lay As Object

For Each Lay In ThisDrawing.Layers
FromLayerList.AddItem Lay.Name
ToLayerList.AddItem Lay.Name
Next

End Sub