Copying objects to clipboard with VBA

[Anonymous]

 Hi all,

I am trying to copy a component from it's own drawing to the clipboard so that I may insert it in a different drawing using VBA. Unfortunately, I seem to be getting stuck with how to store the drawing in the clipboard rather than inserting it into the other drawing. Here is the code I am currently working with (it is a bit of a mess, as I've been trying a few different ways to go about this):

Private Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalFree Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalSize Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As LongPtr) As Long
Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongPtr) As Long
Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
Private Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long
Private Declare PtrSafe Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As LongPtr
Private Declare PtrSafe Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As LongPtr

Private Const GMEM_MOVEABLE = &H2
Private Const GMEM_ZEROINIT = &H40
Private Const GHND = (GMEM_MOVEABLE Or GMEM_ZEROINIT)

Const CF_TEXT = 1
Const MAXSIZE = 4096

Public oFlag As String
'Public oExbom As Workbook
Public Sub ClipBoard_SetData(MyString As String)
'32-bit code by Microsoft: http://msdn.microsoft.com/en-us/library/office/ff192913.aspx
Dim hGlobalMemory As LongPtr, lpGlobalMemory As LongPtr
Dim hClipMemory As LongPtr, X As Long

' Allocate moveable global memory.
hGlobalMemory = GlobalAlloc(GHND, Len(MyString) + 1)

' Lock the block to get a far pointer to this memory.
lpGlobalMemory = GlobalLock(hGlobalMemory)

' Copy the string to this global memory.
lpGlobalMemory = lstrcpy(lpGlobalMemory, MyString)

' Unlock the memory.
If GlobalUnlock(hGlobalMemory) <> 0 Then
MsgBox "Could not unlock memory location. Copy aborted."
'Debug.Print "GlobalFree returned: " & CStr(GlobalFree(hGlobalMemory))
GoTo OutOfHere
End If

' Open the Clipboard to copy data to.
If OpenClipboard(0&) = 0 Then
MsgBox "Could not open the Clipboard. Copy aborted."
Exit Sub
End If

' Clear the Clipboard.
X = EmptyClipboard()

' Copy the data to the Clipboard.
hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory)

OutOfHere:
If CloseClipboard() = 0 Then
MsgBox "Could not close Clipboard."
End If
End Sub

Private Sub UserForm_Activate()

Dim ListArr1(2) As String
ListArr1(0) = "Fuse"
ListArr1(1) = "Surge Arrester"
ComboBox2.List = ListArr1

End Sub

Private Sub CommandButton3_Click()

If ComboBox2 = "Fuse" Then

Dim ListArr2(17) As String
ListArr2(0) = "17.5TDMEJ20"
ListArr2(1) = "24TDMEJ10"
ListArr2(2) = "17.5TDMEJ31.5"
ListArr2(3) = "24TDMEJ20"
ListArr2(4) = "17.5TDMEJ50"
ListArr2(5) = "24TDMEJ25"
ListArr2(6) = "17.5TDMEJ63"
ListArr2(7) = "24TDMEJ31.5"
ListArr2(8) = "DRS15/75-B4"
ListArr2(9) = "24TDMEJ50"
ListArr2(10) = "17.5THMEJ100"
ListArr2(11) = "DRS20/063-B4"
ListArr2(12) = "17.5TKMEJ125"
ListArr2(13) = "DRS15/160-B4"
ListArr2(14) = "DRS20/075-B4"
ListArr2(15) = "DRS15/200-B4"
ListArr2(16) = "DRS20/100-B4"
ComboBox1.List = ListArr2

ElseIf ComboBox2 = "Surge Arrester" Then
Dim ListArr3(2) As String
ListArr3(0) = "9kV"
ListArr3(1) = "18kV"
ComboBox1.List = ListArr3
End If

End Sub

Private Sub CommandButton2_Click()
If ComboBox2 = "Fuse" Then
Call CopyEntities

ElseIf ComboBox2 = "Surge Arrester" And ComboBox1 = "9kV" Then
dwgName = "c:\Users\user\Documents\Dwgs\General\SURGE ARRESTER.dwg"
AcadApplication.Documents.Open dwgName

End If
End Sub

'Sub CapturetoClipboard1()
'Dim Copy As New DataObject
'Dim sourceDwg As AcadDocument
'Dim test As String
'test = "test"
'dwgName = "c:\Users\user\Documents\Dwgs\General\FUSE_HORIZ.dwg"
'AcadApplication.Documents.Open dwgName
'Set sourceDwg = ActiveDocument
'Set Copy = allObjectsArray(selectAllObjects(sourceDwg))
'sourceDwg.CopyObjects allObjectsArray(selectAllObjects(sourceDwg))
'ClipBoard_SetData (Copy)
'End Sub

Public Sub CopyEntities()

dwgName = "c:\Users\user\Documents\Dwgs\General\FUSE_HORIZ.dwg"
AcadApplication.Documents.Open dwgName

Dim curDwg As AcadDocument
Dim entities() As Object
Set curDwg = ActiveDocument
Dim newDwg As AcadDocument
entities = allObjectsArray(selectAllObjects(curDwg))
Set newDwg = Application.Documents.Add()
curDwg.CopyObjects entities, newDwg.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

 As well, I am going to be using this same code to tie part numbers to the components for Bill of Material generation. If anyone can provide suggestions for attributing a part number from a list to the component, that would be greatly appreciated. I have tried using the multiple catalog function through AutoCAD, but it lists all of the parts, even the ones with no quantities selected. I would like to take a part number and tie it to the part when I insert it to the document, if that is possible. 

[rhesusminus]

There already are API calls in AcadE to do much of this. However, it's all LISP, so you'll have to use some sendcommands etc.