Копирование объектов.

Public Sub MergeDXF()
'by Alexey Gromov
Dim i As Integer, j As Integer, n As Integer
Dim nm As String
Dim CollDoc As Object
Dim Elem As Object
Dim SentObj() As AcadEntity
Dim GetingObj As Variant
Dim Atr As Variant
Dim DOCO As Object
Dim MS As AcadModelSpace
Dim PFSS As AcadSelectionSet
Set CollDoc = Application.Documents
Set DOCO = Documents("ИМЯ ИЛИ ИНДЕКС ФАЙЛА-ПРИЕМНИКА")
'Цикл копирования элементов и придания им параметров (по слою, цвету и т.д.)
For i = 0 To CollDoc.Count - 1
    Set MS = CollDoc(i).ModelSpace
    n = MS.Count
    If n = 0 Then
        MsgBox CollDoc(i).name & " не содержит объектов"
        GoTo marker001
    End If
    Erase SentObj 'Обнуление массива (элемент устанавливается в Empty)
    ReDim SentObj(0 To n - 1) 'Установка размерности массива (иначе ошибка)
    nm = CollDoc(i).name
    Select Case Left(nm, 4)
        Case "Лини"
        'Заполняем массив элементов в исходном файле, которые будут скопированы
            For j = 0 To n - 1
                Set SentObj(j) = MS.Item(j)
            Next j
            'Вставляем массив в конечный файл
            GetingObj = Documents(i).CopyObjects(SentObj, DOCO.ModelSpace)
            For j = 0 To n - 1
                'Обработка втавленных элементов
                With GetingObj(j)
                    .Layer = "01 ЛЭП 0.4"
                    .color = acByLayer
                    .Linetype = "ByLayer"
                    .Lineweight = acLnWtByLayer
                    .LinetypeScale = 0.9
                End With
            Next j
        Case "Опор"
            For j = 0 To n - 1
                Set SentObj(j) = MS.Item(j)
            Next j
            GetingObj = Documents(i).CopyObjects(SentObj, DOCO.ModelSpace)
            For j = 0 To n - 1
                With GetingObj(j)
                    .Layer = "13 КТП съемка"
                    .color = acByLayer
                    .Linetype = "ByLayer"
                    .Lineweight = acLnWtByLayer
                    .LinetypeScale = 1#
                End With
            Next j
    End Select
marker001:
Next i
'Закрытие файлов DXF
'If MsgBox("Закрыть файлы DXF?", vbYesNo) = vbYes Then
    For Each Elem In CollDoc
        nm = Right(Elem.name, 4)
        If StrComp(nm, ".dxf", vbTextCompare) = 0 Then
            Elem.Close SaveChanges:=False
        End If
    Next Elem
'Else
'End If
DOCO.Activate
End Sub