day is over, gtg
here is something for you to try....
need some code to create the new doc, then reactivate the original etc ....
hope this helps, if not i'll try to do something tomorrow
Public Sub LayOut_copy(strFrom As String, strTo As String)
Dim objLayOut As AcadLayout
Dim objEnt As AcadObject
Dim objNewLayOut As AcadLayout
Dim colLayOuts As AcadLayouts
Dim objEntArray() As Object
Dim intCnt As Integer
Dim blnExists As Boolean
Set colLayOuts = ThisDrawing.Layouts
For Each objLayOut In colLayOuts
If objLayOut.Name = "VBD LayOut" Then
blnExists = True
Exit For
End If
Next objLayOut
If Not blnExists Then
Set objNewLayOut = colLayOuts.Add(strTo)
Set objLayOut = colLayOuts.Item(strFrom)
ReDim objEntArray(objLayOut.Block.Count - 1)
For Each objEnt In objLayOut.Block
Set objEntArray(intCnt) = objEnt
intCnt = intCnt + 1
Next
ThisDrawing.CopyObjects objEntArray, objNewLayOut.Block
objNewLayOut.CopyFrom objLayOut
End If
End Sub
