我不记得我从哪里得到这个。
- Public Function CopyLayout(Source As AcadLayout, TargetName As String) As AcadLayout
- Dim Doc As AcadDocument, Layout As AcadLayout
- Dim objArray() As Object, i As Integer
- Set Doc = Source.Document
- Set Layout = Doc.Layouts.Add(TargetName)
- If Source.Block.count > 0 Then
- ReDim objArray(0 To Source.Block.count - 1)
- For i = 0 To Source.Block.count - 1
- Set objArray(i) = Source.Block.Item(i)
- Next
- Doc.CopyObjects objArray, Layout.Block
- End If
- Layout.CopyFrom Source
- Set CopyLayout = Layout
- End Function
|