Copy an paste Autocad drawing oBject by VBA

Hi to everybody,
I'm searching for some sample code in order to copy all drawing objects into clipboard and paste into another drawing.

Seem it's mission impossible with VBA embedded in Autocad.

Thank you,

Can you not instead simply use the COPYBASE Command OOTB?

Quote:

---

Originally Posted by BlackBox

Can you not instead simply use the COPYBASE Command OOTB?

---

Thank you for your answer, I have to replace some parts in 130 DWG !! so I'm searching something like a procedure, your command work fine, I'll try to use in a script....

Thank you.

if sticking to VBA you could use the "CopyObjects" method of the Document or Database object
the following code copies all object from the active document to a newly created one but you can simply adapt it to your needs

Code:

---

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

---

and here they are the called functions

Code:

---

Function selectAllObjects(myDoc As AcadDocument) As AcadSelectionSet

Set selectAllObjects = CreateSelectionSet("mySel", myDoc)
myDoc.Application.ZoomAll
selectAllObjects.Select acSelectionSetAll
   
End Function

---

Code:

---

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

---

Code:

---

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

---

Thank you RICVBA I'll try asap

grobnik, still no luck?