Message 1 of 12
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
This is the code I am using to copy all objects from one drawing to another.
For some reason it does not copy tables and dimensions. Is there a reason why?
Option Explicit
Sub CopyAllObjects()
Dim sourceDwg As AcadDocument, destDwg As AcadDocument
Set sourceDwg = ActiveDocument
Set destDwg = Documents.Add
sourceDwg.CopyObjects allObjectsArray(selectAllObjects(sourceDwg)), destDwg.ModelSpace
End Sub
Function selectAllObjects(myDoc As AcadDocument) As AcadSelectionSet
Set selectAllObjects = CreateSelectionSet("mySel", myDoc)
myDoc.Application.ZoomAll
selectAllObjects.Select acSelectionSetAll
End Function
Function allObjectsArray(ss As AcadSelectionSet)
Dim iEnt As Long
ReDim Objects(0 To ss.count - 1) As AcadEntity
For iEnt = 0 To ss.count - 1
Set Objects(iEnt) = ss.Item(iEnt)
Next iEnt
allObjectsArray = Objects
End Function
Function CreateSelectionSet(SSset As String, Optional myDoc As Variant) As AcadSelectionSet
If IsMissing(myDoc) Then Set myDoc = ThisDrawing
On Error Resume Next
Set CreateSelectionSet = myDoc.SelectionSets(SSset)
If Err Then
Set CreateSelectionSet = myDoc.SelectionSets.Add(SSset)
Else
CreateSelectionSet.Clear
End If
End Function
--Moderator edit: Changed the code format to VB.
Solved! Go to Solution.