| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму | Файлообменник |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Помогите доделать программу добавления объектов в блок

Помогите доделать программу добавления объектов в блок

Ответ
Поиск в этой теме
Непрочитано 19.05.2006, 21:18 #1
Помогите доделать программу добавления объектов в блок
МишаVBA
 
Инженер
 
г. Томск
Регистрация: 14.05.2006
Сообщений: 4

Нужна программа добавления выделеных объектов в блок в тот момент когда редактируется внешний блок и выделеные объекты надо добавить в один из внутрених блоков внешнего блока. 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, а неработающая строка написана для выражения общей идеи программы.
__________________
С уважением, Михаил!
Просмотров: 7118
 
Непрочитано 20.05.2006, 01:04
#2
fixo

Lisp/VBA/VB.NET Hobbyist
 
Регистрация: 24.03.2005
Славен Град Петров
Сообщений: 367


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

Fatty

~'J'~
fixo вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > Помогите доделать программу добавления объектов в блок

Размещение рекламы
Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск