VBA merge layers....copy content of a layer to other layer

Hello! Can someone help me solve this annoing problem?

A have to make a script ...that renames the name of some layers.. ex (layer name "102" and layer name "104" must merge into "test1") .. at first...i was just renameing ..each layer... but i receive the error that says that the layer is already existing "duplicate error" ... and now i must copy the content of layer "102" to layer "104" and then rename "104" to "test1" but i'm kind of new into VBA scripting in AutoCAD!

PS. I have to process a large number of files..and it can't be done manualy beacuse the lack of time.. i must make it by vba script beacuse vb is the only language a know!

I'd use something like this ( AutoLisp )

[b][color=BLACK]([/color][/b]defun c:mergel [b][color=FUCHSIA]([/color][/b]/ vlist laylist ss tdef fe fd el[b][color=FUCHSIA])[/color][/b]

 [b][color=FUCHSIA]([/color][/b]setq vlist '[b][color=NAVY]([/color][/b][b][color=MAROON]([/color][/b][color=#2f4f4f]"ELEVATION"[/color] . 0[b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b][color=#2f4f4f]"THICKNESS"[/color]  . 0[b][color=MAROON])[/color][/b]
               [b][color=MAROON]([/color][/b][color=#2f4f4f]"CELTSCALE"[/color] . 1[b][color=MAROON])[/color][/b] [b][color=MAROON]([/color][/b][color=#2f4f4f]"CECOLOR"[/color]   . [color=#2f4f4f]"BYLAYER"[/color][b][color=MAROON])[/color][/b]
               [b][color=MAROON]([/color][/b][color=#2f4f4f]"CELTYPE"[/color]   . [color=#2f4f4f]"BYLAYER"[/color][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]foreach v vlist
     [b][color=NAVY]([/color][/b]and [b][color=MAROON]([/color][/b]getvar [b][color=GREEN]([/color][/b]car v[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
          [b][color=MAROON]([/color][/b]setvar [b][color=GREEN]([/color][/b]car v[b][color=GREEN])[/color][/b] [b][color=GREEN]([/color][/b]cdr v[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]


 [b][color=FUCHSIA]([/color][/b]setq laylist '[b][color=NAVY]([/color][/b][b][color=MAROON]([/color][/b][color=#2f4f4f]"OLD-LAYER"[/color] . [color=#2f4f4f]"NEW-LAYER"[/color][b][color=MAROON])[/color][/b]
                 [b][color=MAROON]([/color][/b][color=#2f4f4f]"3D-SZG"[/color]    . [color=#2f4f4f]"SNEEZE"[/color][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]

 [b][color=FUCHSIA]([/color][/b]command [color=#2f4f4f]"_.LAYER"[/color][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]foreach l laylist
      [b][color=NAVY]([/color][/b]if [b][color=MAROON]([/color][/b]not [b][color=GREEN]([/color][/b]tblsearch [color=#2f4f4f]"LAYER"[/color] [b][color=BLUE]([/color][/b]cdr l[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
          [b][color=MAROON]([/color][/b]command [color=#2f4f4f]"_New"[/color] [b][color=GREEN]([/color][/b]cdr l[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]command [color=#2f4f4f]""[/color][b][color=FUCHSIA])[/color][/b]

 [b][color=FUCHSIA]([/color][/b]foreach l laylist
      [b][color=NAVY]([/color][/b]and [b][color=MAROON]([/color][/b]setq ss [b][color=GREEN]([/color][/b]ssget [color=#2f4f4f]"X"[/color] [b][color=BLUE]([/color][/b]list [b][color=RED]([/color][/b]cons 8 [b][color=PURPLE]([/color][/b]car l[b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
           [b][color=MAROON]([/color][/b]command [color=#2f4f4f]"_.CHPROP"[/color] ss [color=#2f4f4f]""[/color] [color=#2f4f4f]"_LA"[/color] [b][color=GREEN]([/color][/b]cdr l[b][color=GREEN])[/color][/b] [color=#2f4f4f]""[/color][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]

 [b][color=FUCHSIA]([/color][/b]while [b][color=NAVY]([/color][/b]setq tdef [b][color=MAROON]([/color][/b]tblnext [color=#2f4f4f]"BLOCK"[/color] [b][color=GREEN]([/color][/b]not tdef[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
        [b][color=NAVY]([/color][/b]setq fe [b][color=MAROON]([/color][/b]cdr [b][color=GREEN]([/color][/b]assoc -2 tdef[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
        [b][color=NAVY]([/color][/b]entmake tdef[b][color=NAVY])[/color][/b]
        [b][color=NAVY]([/color][/b]while fe
             [b][color=MAROON]([/color][/b]setq fd [b][color=GREEN]([/color][/b]entget fe[b][color=GREEN])[/color][/b]
                   el [b][color=GREEN]([/color][/b]cdr [b][color=BLUE]([/color][/b]assoc 8 fd[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
             [b][color=MAROON]([/color][/b]if [b][color=GREEN]([/color][/b]assoc el laylist[b][color=GREEN])[/color][/b]
                 [b][color=GREEN]([/color][/b]setq fd [b][color=BLUE]([/color][/b]subst [b][color=RED]([/color][/b]cons 8 [b][color=PURPLE]([/color][/b]cdr [b][color=TEAL]([/color][/b]assoc el laylist[b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b]
                                 [b][color=RED]([/color][/b]assoc 8 fd[b][color=RED])[/color][/b] fd[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
             [b][color=MAROON]([/color][/b]entmake fd[b][color=MAROON])[/color][/b]
             [b][color=MAROON]([/color][/b]setq fe [b][color=GREEN]([/color][/b]entnext fe[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
        [b][color=NAVY]([/color][/b]entmake [b][color=MAROON]([/color][/b]list [b][color=GREEN]([/color][/b]cons 0 [color=#2f4f4f]"ENDBLK"[/color][b][color=GREEN])[/color][/b][b][color=GREEN]([/color][/b]cons 8 [color=#2f4f4f]"0"[/color][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]

 [b][color=FUCHSIA]([/color][/b]prin1[b][color=FUCHSIA])[/color][/b][b][color=BLACK])[/color][/b]

You could format the layer list externally and then read it globally into each dwg or just completely compile the list inside the routine as it is now.

I'd be careful cause it will destroy the handle data. -David

Thank u David! but as I mentioned I don't know lisp! But thank u for trying to help! I've resolved the problem with finding some pieces of code in VBA like selecting all content of a layer...and then the process was kind simple!

For everyone that have the same problem like i did...ask me for the code and i'l give it to u!

And sorry for my bad english!

I am having a similar problem... You think you could post the code so I could try it?

this is the code ... i hope it will help u

Private Sub button1_Click()

Dim acadDoc As AutoCAD.AcadDocument
Set acadDoc = AutoCAD.Documents.Open("C:\test.dwg")


Dim lays As AcadLayers
Dim layerObj As AcadLayer
Dim lay As AcadLayer
Dim strLayerName As String
   
On Error Resume Next
   'Set lays = ThisDrawing.Layers
Set lays = acadDoc.Layers 


'set the layer to default
ThisDrawing.ActiveLayer = lays.Item(0)

'go trough all the layers
For Each lay In lays
           Set layerObj = acadDoc.Layers(lay.Name)
'listbox1 is the list with the layer names that are initialy
'listbox2 is the list with the layer names that are becoming 
'ex: listbox1 contains (103, 150, 160)
' and listbox2 contains (a, b, c) 103 is becoming a .. 150 is becoming b and 160 is becoming c
'if u have ..listbox1(103, 150, 160) and listbox2 (a, a, c)
'then a error..ocurs..and is captured.. then..takes all the elements on
'then layer 150 and copy them to the layer a ..and then deletes the 150 
'and so on...
'the listbox u can fill them from a txt file ... 

               For i = 0 To ListBox1.ListCount - 1
               
                   If layerObj.Name = ListBox1.List(i) Then
                       layerObj.Name = ListBox2.List(i)
                       
                           If Err.Number = "-2145386405" Then
'Testselectionsetfilter is the sub that copies the information from one layer to the other
                               Testselectionsetfilter ListBox1.List(i), ListBox2.List(i)
                               acadDoc.Layers.Item(ListBox1.List(i)).Delete
                           End If
                   End If
               Next i
       Next lay

Private Sub Testselectionsetfilter(layer_init As String, layer_dest As String)
   Dim objss As AcadSelectionSet
   Dim intcodes(0) As Integer
   Dim varcodevalues(0) As Variant
   Dim strname As String
   
On Error GoTo done
   
       strname = layer_init
       If "" = strname Then Exit Sub
       
       ''create new selectionset
       Set objss = ThisDrawing.SelectionSets.Add("Testselectionsetfilter")
       ''set the code for layer
       intcodes(0) = 8
       
       ''set the value specified by user
       varcodevalues(0) = strname
       
       ''filter the objects
       objss.Select acSelectionSetAll, , , intcodes, varcodevalues
       
       ''highlight the selected entities
       objss.Highlight True
             
        For i = 0 To objss.Count
      
        objss.Item(i).layer = layer_dest
     
        Next i
                     
done:
       '' if the selection was created , delete it
       If Not objss Is Nothing Then
       objss.Delete
       End If

End Sub

End sub

i've posted the code