Sub test()
Dim ent As AcadEntity
Dim sset As AcadSelectionSet
Dim intData() As Integer, varData() As Variant
Dim objCollection() As Object
Dim activeDoc As AcadDocument
'..............................................
'dxfnam=.....
'intData
'varData
'..............................................
Set sset = ThisDrawing.SelectionSets.Add("SS1")
sset.Select acSelectionSetAll, , , intData, varData
If sset.Count = 0 Then Exit Sub
Set activeDoc = ThisDrawing.Application.ActiveDocument
docpath = activeDoc.Path
ReDim objCollection(0 To sset.Count - 1)
i = 0
For Each ent In sset
Set objCollection(i) = ent
i = i + 1
Next
CopyObjects activeDoc, objCollection, docpath, dxfnam
ThisDrawing.SelectionSets.Item("SS1").Delete: Set sset = Nothing
Exit Sub
End Sub
'######################################################################################
Sub CopyObjects(activeDoc As AcadDocument, objCollection() As Object, docpath, dxfnam)
Dim ent As AcadEntity
Dim newDoc As AcadDocument
Set newDoc = Documents.Add ' Create a new drawing
retObjects = activeDoc.CopyObjects(objCollection, newDoc.ModelSpace)
' retObjects что-то делаем со скопированными объектами
ThisDrawing.SaveAs docpath & "\" & dxfnam, ac2007_dxf
newDoc.Close
Exit Sub
End Sub