[ArtemYa]

Здравствуйте, подскажите пожалуйста советом новичку.
Задача следуующая:
Есть некий объект, который имеет две составляющие на чертеже A и В, рамка чертежа -С. Объеты А и В - блоки на чертеже, так же как и рамка С имеют атрибуты. А и В могут находиться на разных листах. Если объект В находиться в поле рамки С, то одному из атрибутов объекта А нужно присвоить атрибут рамки "номер страницы" рамки С, в которой находится объект В. В общем запутался я в координатах, подскажите как из блоков можно вытащить координаты. Так же не могу разобраться как экспортировать атрибуты из када в эксель. Кто знает, подскажите!!!Заранее благодарю!!!

[Олег (jr.)]

Сообщение от ArtemYa Здравствуйте, подскажите пожалуйста советом новичку. Задача следуующая: Есть некий объект, который имеет две составляющие на чертеже A и В, рамка чертежа -С. Объеты А и В - блоки на чертеже, так же как и рамка С имеют атрибуты. А и В могут находиться на разных листах. Если объект В находиться в поле рамки С, то одному из атрибутов объекта А нужно присвоить атрибут рамки "номер страницы" рамки С, в которой находится объект В. В общем запутался я в координатах, подскажите как из блоков можно вытащить координаты. Так же не могу разобраться как экспортировать атрибуты из када в эксель. Кто знает, подскажите!!!Заранее благодарю!!!

Положи сюда чертеж

~'J'~

[Кулик Алексей aka kpblc]

ArtemYa, твое счастье, что уже есть ответ. Иначе тема была бы уже удалена (с таким названием).
Переименовывай!

[Do$]

Определить точку вставки блока: запросить свойство InsertionPoint.
Определить границы блока: применить метод GetBoundingBox (правда, он для динамических блоков работает не так, как хотелось бы).

[ArtemYa]

Спасибо, все получилось, буду пробовать дальше

[Кулик Алексей aka kpblc]

Do$, а если попытаться обращаться к описанию конкретого вхождения? То есть обрабатывать (фактически) анонимный блок?

[Do$]

Знать бы еще, каким образом обращаются к блокам на VBA
Анонимный - это, я так понимаю, блок, у которого свойство Name имеет вид наподобие "*U115"?

[Кулик Алексей aka kpblc]

Так, прошу ногами по голове не охаживать - я попросту запутался

Код:

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

Public Sub test()
Dim ent As AcadEntity, BlockRef As AcadBlockReference, BlockDef As AcadBlock
Dim pickPoint As Variant, minPoint As Variant, maxPoint As Variant

  On Error GoTo lErrorGetEnt
  ThisDrawing.Utility.GetEntity ent, pickPoint, "Select a block"
  Set BlockRef = ent
  BlockRef.GetBoundingBox minPoint, maxPoint
  
  ThisDrawing.ObjectIdToObject(BlockRef.OwnerID).AddPoint minPoint
  ThisDrawing.ObjectIdToObject(BlockRef.OwnerID).AddPoint maxPoint
  
  Exit Sub
  
lErrorGetEnt:
  MsgBox "Error entity selection", vbOKOnly + vbCritical + vbApplicationModal, "Error"
  Exit Sub
  
End Sub

И вариант "получче":

Код:

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

Public Sub test2()
Dim ent As AcadEntity, BlockRef As AcadBlockReference
Dim pickPoint As Variant, minPoint As Variant, maxPoint As Variant

  On Error GoTo lErrorGetEnt
  ThisDrawing.Utility.GetEntity ent, pickPoint, "Select a block"
  If UCase(ent.ObjectName) Like "*BLOCK*" Then
    Set BlockRef = ent
    If BlockRef.IsDynamicBlock Then
      BlockRef.GetBoundingBox minPoint, maxPoint
      
      ThisDrawing.ObjectIdToObject(BlockRef.OwnerID).AddPoint minPoint
      ThisDrawing.ObjectIdToObject(BlockRef.OwnerID).AddPoint maxPoint
    End If
  End If
  
  Exit Sub
  
lErrorGetEnt:
  MsgBox "Error entity selection", vbOKOnly + vbCritical + vbApplicationModal, "Error"
  Exit Sub
  
End Sub

---
Добавлено: как всегда, некорректно обрабатывается поворот блока, с масштабами проблема и т.п. Но зато и обращение идет именно к вхождению
---
Добавлено 2: Ну и вариант получения координат с описания блока. Дальнейшие преобразования (поворот, масштабирование и перевод в другую систему) я сделать не в силах А так, в качестве примера / затравки - см

Код:

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

Public Sub GetBoxByDefinition()
Dim PickedEnt As AcadEntity, BlockDef As AcadBlock, _
  PickedPoint As Variant, minPoint As Variant, maxPoint As Variant, iCounter As Integer, _
  InsPoint As Variant
  
  On Error GoTo lErrorGetEnt
  ThisDrawing.Utility.GetEntity PickedEnt, PickedPoint, "Select a block"
  If UCase(PickedEnt.ObjectName) Like "*BLOCK*" Then
    InsPoint = PickedEnt.InsertionPoint
    Set BlockDef = ThisDrawing.Blocks.Item(PickedEnt.Name)
    Dim SubEnt As AcadEntity, SubMinPoint As Variant, SubMaxPoint As Variant
    
    For Each SubEnt In BlockDef
      SubEnt.GetBoundingBox minPoint, maxPoint
      If IsEmpty(SubMinPoint) Then
        SubMinPoint = minPoint
      Else
        For iCounter = 0 To 2
          If minPoint(iCounter) < SubMinPoint(iCounter) Then SubMinPoint(iCounter) = minPoint(iCounter)
        Next
      End If
      If IsEmpty(SubMaxPoint) Then
        SubMaxPoint = maxPoint
      Else
        For iCounter = 0 To 2
          If maxPoint(iCounter) > SubMinPoint(iCounter) Then SubMinPoint(iCounter) = maxPoint(iCounter)
        Next
      End If
    Next
    
  End If
  
  Exit Sub
  
lErrorGetEnt:
  MsgBox "Error entity selection", vbOKOnly + vbCritical + vbApplicationModal, "Error"
  Exit Sub
  
End Sub

---
Сейчас придет fixo и от меня останутся рожки да ножки

[ArtemYa]

Я просто перебираю все элементы (AcadEntity) в Modelspace, если элемент является динамическим блоком (AcadBlockReference) нужного имени, нахожу его точку привязки(вставки), если это касается чертежной рамки, то по имени блока я уже знаю какого рамка формата, отсюда и могу найти все ее координаты, предварительно определив их и сделав массив!

Появился еще один вопрос, как сравнить два элемента типа Variant, просто знаком равно не получатеся....