Тема: Копирование в буфер из VBA

Пожалуйста подскажите где ошибка?
В Lispе выражение работает  (setq t (ssget))
                             (command "_copyclip" t "");копирование в буфер

А в VBA ни как не могу этого добиться.
Заранее благодарю.

Set sset = ThisDrawing.SelectionSets.Add("SS1")
     
'добаляем в набор объекты методом SelectOnScreen отфильтровывая только замкнутые объекты
'фильтр для выбора замкнутых объектов
Dim FilteType(0) As Integer
Dim Filtedata(0) As Variant
FilteType(0) = 70
Filtedata(0) = 1
sset.SelectOnScreen FilteType, Filtedata
 
'копируем в буфер набор
ThisDrawing.SendCommand ("_copyclip" & sset & vbCr)

Подставлял "методом тыка" и SS1 и sset, как только мог,
не получилось.Ручки наверное кривоваты sad(.

Re: Копирование в буфер из VBA

Непонятно зачем Вам нужен SendCommand? Судя по всему, поскольку Вы выбираете объекты, то очевидно Вам надо вставить их в другой чертеж, это во-первых. И, во-вторых, раз Вы используете "_copyclip", а не "_copybase", в чертеж-"приемник" объекты должны вставляться с оригинальными координатами. Поэтому вполне можно использовать метод CopyObjects - это первый вариант.

Если очень хочется использовать SendCommand, то напрямую передать набор объектов в командную строку не удастся. Но все гораздо проще. После применения SelectOnScreen у Вас в чертеже образуется набор, который можно выделить используя опцию "P".

-------------------------------------------------------------------

Option Explicit
Option Compare Text
Option Base 0

Sub copyObjVar1()

Dim objSelSet As AcadSelectionSet
Dim arrObj() As AcadEntity
Dim varObj As Variant
Dim newDoc, oldDoc As AcadDocument
Dim FilteType(0) As Integer
Dim Filtedata(0) As Variant

Dim i As Long


For Each objSelSet In ThisDrawing.SelectionSets
     If objSelSet.Name = "temp" Then
         objSelSet.Delete
         Exit For
     End If
Next
   
Set objSelSet = ThisDrawing.SelectionSets.Add("temp")

FilteType(0) = 70
Filtedata(0) = 1

objSelSetSelectOnScreen FilteType, Filtedata

If objSelSet.Count = 0 Then
     GoTo Exit_Here
End If

ReDim arrObj(objSelSet.Count - 1) As AcadEntity

For i = 0 To objSelSet.Count - 1
     Set arrObj(i) = objSelSet(i)
Next

Set oldDoc = AutoCAD.ActiveDocument
' Можно выбрать проект - "приемник", здесь вставка в новый чертеж
Set newDoc = AutoCAD.Documents.Add

varObj = oldDoc.CopyObjects(arrObj, newDoc.ModelSpace)

Exit_Here:

Set objSelSet = Nothing
Set varObj = Nothing
Set newDoc = Nothing
Set oldDoc = Nothing

End Sub

---------------------------------------------------------

Sub copyObjVar2()

Dim objSelSet As AcadSelectionSet
Dim FilteType(0) As Integer
Dim Filtedata(0) As Variant

For Each objSelSet In ThisDrawing.SelectionSets
     If objSelSet.Name = "temp" Then
         objSelSet.Delete
         Exit For
     End If
Next
   
Set objSelSet = ThisDrawing.SelectionSets.Add("temp")

FilteType(0) = 70
Filtedata(0) = 1

objSelSetSelectOnScreen FilteType, Filtedata

If objSelSet.Count = 0 Then
     GoTo Exit_Here
End If

ThisDrawing.SendCommand ("_copyclip" & vbCr & "p" & vbCr & vbCr)

Exit_Here:

Set objSelSet = Nothing

End Sub

Re: Копирование в буфер из VBA

Огромное СПАСИБО гн.Bender!!!
Все получилось. Правда не сразу сообразил, что "_p"
параметр указывающий на последний созданный набор.
Оч-ч-ень изящно.

Re: Копирование в буфер из VBA

Примечание: выражение (setq t (ssget)) переопределяет встроенный символ LISPа T(True), после чего его исходное значение становится недоступным. Этому символу присваивать значения НЕ НАДО НИКОГДА.

Re: Копирование в буфер из VBA

в строке objSelSetSelectOnScreen FilteType, Filtedata
выдает ошибку Sub or Function not defined
процедуру даже не запускает :(

Re: Копирование в буфер из VBA

А зачем тебе SelectOnScreen, я так понял это для ручного выделения объектов на экране, я вообще этот кусок выкинул.

Re: Копирование в буфер из VBA

в строке objSelSetSelectOnScreen FilteType, Filtedata
выдает ошибку Sub or Function not defined
процедуру даже не запускает :(
objSelSet.SelectOnScreen FilteType, Filtedata

Re: Копирование в буфер из VBA

bob, а как скпировать именной объект и вставить его в новую книгу?

Re: Копирование в буфер из VBA

Вопрос. Как на VBA (проще всего) скопировать значение TextBox_a в буфер не выделяя TextBox?

Re: Копирование в буфер из VBA

> Agens
Не помню где я это слямзил, вроде работает:

Option Explicit
Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) _
As Long
Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) _
As Long
Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, _
ByVal dwBytes As Long) As Long
Declare Function CloseClipboard Lib "User32" () As Long
Declare Function OpenClipboard Lib "User32" (ByVal hwnd As Long) _
As Long
Declare Function EmptyClipboard Lib "User32" () As Long
Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, _
ByVal lpString2 As Any) As Long
Declare Function SetClipboardData Lib "User32" (ByVal wFormat _
As Long, ByVal hMem As Long) As Long
Public Const GHND = &H42
Public Const CF_TEXT = 1
Public Const MAXSIZE = 4096
Function ClipBoard_SetData(MyString As String)
Dim hGlobalMemory As Long, lpGlobalMemory As Long
Dim hClipMemory As Long, X As Long
' Allocate movable 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."
GoTo OutOfHere2
End If
' Open the Clipboard to copy data to.
If OpenClipboard(0&) = 0 Then
MsgBox "Could not open the Clipboard. Copy aborted."
Exit Function
End If
' Clear the Clipboard.
X = EmptyClipboard()
' Copy the data to the Clipboard.
hClipMemory = SetClipboardData(CF_TEXT, hGlobalMemory)
OutOfHere2:
If CloseClipboard() = 0 Then
MsgBox "Could not close Clipboard."
End If
End Function
''~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~''
Private Sub CommandButton1_Click()
modClipBoard.ClipBoard_SetData (TextBox1.Text)
Unload Me
End Sub

~'J'~

Re: Копирование в буфер из VBA

Мне вот эта понравилось:
-------------------------
Пример как поместить число в буфер обмена в VBA:
Public Sub Clip()
Dim d As New DataObject
Dim s As Single
d.Clear
s = 11.11
d.SetText s
d.PutInClipboard
End Sub
--------
взято тут - DWG.RU
--------
Спасибо С1