topic Export Layout tabs into seperate drawings. in VBA Forum

Export Layout tabs into seperate drawings.

Anonymous — Wed, 03 May 2006 15:35:32 GMT

What is the best method of copying out layouts from a drawing into seperate
drawings named after the layout tab itself.

Re: Export Layout tabs into seperate drawings.

Anonymous — Wed, 03 May 2006 15:53:49 GMT

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

Re: Export Layout tabs into seperate drawings.

Anonymous — Wed, 03 May 2006 16:03:36 GMT

Thanks for the start

wrote in message news:5162478@discussion.autodesk.com...
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