[МишаVBA]

Нужна программа добавления выделеных объектов в блок в тот момент когда редактируется внешний блок и выделеные объекты надо добавить в один из внутрених блоков внешнего блока. AutoCAD этого не позволяет:

Код:

[Выделить все]

Private Sub CommandButton15_ДобавитьВыделенныеОбъектыВБлок_Click()
Dim lngНомОбъекта As Long, acobjОбъектЧертежа As acadObject, lngКолвоОбъектов As Long
Dim selsetНаборОбъектов As AcadSelectionSet, acobjСсылкаНаБлок As AcadBlockReference
Dim removeObject(0 To 0) As AcadEntity
On Error GoTo ОбработкаОшибок
   If ПризнакНаличияЭлементаВКоллекции("ОБЪЕКТЫДОБАВЛЯЕМЫЕВБЛОК", ThisDrawing.SelectionSets, 2) Then
      ThisDrawing.SelectionSets("ОБЪЕКТЫДОБАВЛЯЕМЫЕВБЛОК").Delete
   End If
   Set selsetНаборОбъектов = ThisDrawing.SelectionSets.Add("ОБЪЕКТЫДОБАВЛЯЕМЫЕВБЛОК")
   Me.Hide
   selsetНаборОбъектов.SelectOnScreen
ВыделитьБлок:
   ThisDrawing.Utility.GetEntity acobjСсылкаНаБлок, vBasePoint, "Выдели блок в который надо добавить объекты:"
   If Not TypeOf acobjСсылкаНаБлок Is AcadBlockReference Then
      glngОтвет = MsgBox("Продолжать выделять блок?", vbInformation, gstrНазваниеПрограммы)
      If glngОтвет = vbNo Then
         Me.Show
      ElseIf glngОтвет = vbCancel Then
         End
      End If
      GoTo ВыделитьБлок
   End If
'Проверим не находится ли выделеный блок среди выделеных объектов ранее
   For lngНомОбъекта = 0 To selsetНаборОбъектов.Count - 1
      Set acobjОбъектЧертежа = selsetНаборОбъектов(lngНомОбъекта)
      If TypeOf acobjОбъектЧертежа Is AcadBlockReference Then
         If acobjОбъектЧертежа.Name = acobjСсылкаНаБлок.Name Then
            Set removeObject(0) = acobjОбъектЧертежа
            selsetНаборОбъектов.RemoveItems removeObject
            lngНомОбъекта = lngНомОбъекта - 1
         End If
      End If
      lngНомОбъекта = lngНомОбъекта + 1
   Next lngНомОбъекта
'Добавим отфильтрованные выделенные объекты в блок
   ThisDrawing.Blocks(acobjСсылкаНаБлок.Name).AddItems selsetНаборОбъектов
'Удалим выделеные объекты
   lngКолвоОбъектов = selsetНаборОбъектов.Count
   selsetНаборОбъектов.Erase
   selsetНаборОбъектов.Delete
   acobjСсылкаНаБлок.Update
   MsgBox "В блок """ & acobjСсылкаНаБлок.Name & " добавлено " & lngКолвоОбъектов & " объектов.", vbInformation, gstrНазваниеПрограммы
   Me.Show
ОбработкаОшибок:
   MsgBox "При добавлении объектов в блок произошла ошибка:" & vbLf & _
         "номер = " & Err.Number & vbLf & _
         "с описанием: " & Err.Description, vbExclamation, gstrНазваниеПрограммы
   Resume Next
End Sub

Строка

Код:

[Выделить все]

ThisDrawing.Blocks(acobjСсылкаНаБлок.Name).AddItems selsetНаборОбъектов

не работает, чем можно заменить эту строку?
Сразу предупреждаю: метод AddItems есть только у объекта AcadSelectionSet, а неработающая строка написана для выражения общей идеи программы.

[fixo]

Здесь нужно использовать метод CopyObjects, но сначала
надо преобразовать набор в массив объектов
Что-то вроде:
Dim varObjects() as Object
-------
ThisDrawing.CopyObjects(varObjects, ThisDrawing.Blocks _(acobjСсылкаНаБлок.Name))

Fatty

~'J'~