[Ploikin]

Необходимо построить прямоугольную рамку вокруг блока.

Код:

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

Sub Example_GetBoundingBox()
    ' This example creates a line in model space. It then finds the
    ' bounding box for the line and displays the corners of the box.
 
    Dim startPoint(0 To 2) As Double
    Dim endPoint(0 To 2) As Double
    Dim lineObj As AcadLine
 
    ' Create the Line object in model space
    startPoint(0) = 2#: startPoint(1) = 2#: startPoint(2) = 0#
    endPoint(0) = 4#: endPoint(1) = 4#: endPoint(2) = 0#
    Set lineObj = ThisDrawing.ModelSpace.AddLine(startPoint, endPoint)
    ZoomAll
 
    Dim minExt As Variant
    Dim maxExt As Variant
 
    ' Return the bounding box for the line and return the minimum
    ' and maximum extents of the box in the minExt and maxExt variables.
    lineObj.GetBoundingBox minExt, maxExt
 
    ' Print the min and max extents
    MsgBox "The extents of the bounding box for the line are:" & vbCrLf _
         & "Min Extent: " & minExt(0) & "," & minExt(1) & "," & minExt(2) _
         & vbCrLf & "Max Extent: " & maxExt(0) & "," & maxExt(1) & "," & maxExt(2), vbInformation, "GetBoundingBox Example"
         
End Sub

сказали, что нужно использовать гетбоундингбокс, но пример из "справочника" строит отрезок, а не определяет нижнюю левую и верхнюю правую точки блока

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

Потому что minExt и maxExt - точки. Посмотри в отладчике.
Ничто и никто не мешает получить дополнительные точки по принципу

Код:

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

Dim apppoint1(0 to 1) As Double
apppoint(0) = minExt(0)
apppoint(1) = maxExt(1)

[Ploikin]

Сообщение от Ploikin Dim startPoint(0 To 2) As Double Dim endPoint(0 To 2) As Double Dim lineObj As AcadLine

определяем стартовую, конечную точки (от 0 до 2 - 3 оси координат)
определяем объект линия для дальнейшего построения отрезка

Сообщение от Ploikin startPoint(0) = 2#: startPoint(1) = 2#: startPoint(2) = 0# endPoint(0) = 4#: endPoint(1) = 4#: endPoint(2) = 0# Set lineObj = ThisDrawing.ModelSpace.AddLine(startPoint, endPoint) ZoomAll

присваиваем значения координат стартовой и конечной точкам (2-2-0) и (4-4-0), ось ptl не используется
создаем линию, которая соединяет эти точки

Сообщение от Ploikin Dim minExt As Variant Dim maxExt As Variant

вводим точки мин и макс

Сообщение от Ploikin lineObj.GetBoundingBox minExt, maxExt MsgBox "The extents of the bounding box for the line are:" & vbCrLf _ & "Min Extent: " & minExt(0) & "," & minExt(1) & "," & minExt(2) _ & vbCrLf & "Max Extent: " & maxExt(0) & "," & maxExt(1) & "," & maxExt(2), vbInformation, "GetBoundingBox Example"

Выводит координаты в виде сообщения

Сообщение от Кулик Алексей aka kpblc Dim apppoint1(0 to 1) As Double apppoint(0) = minExt(0) apppoint(1) = maxExt(1)

как я понял, присваиваем точке апппоинт1 координаты Х левой нижней точки и У верхней правой точки, в итоге получаем верхнюю левую точку
[IMG]http://***********/660d7863.jpg[/IMG] месседж, получается за блок принимает линию, которую нарисовали ваше, а у меня есть уже блок надо у него эти координаты определить

Код:

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

Public Function SelectOnlyOnScreen() As AcadSelectionSet
 Dim objSelSet As AcadSelectionSet
 Dim objSelCol As AcadSelectionSets
 Dim intType(0) As Integer
 Dim varData(0) As Variant
 Set objSelCol = ThisDrawing.SelectionSets
 For Each objSelSet In objSelCol
 If objSelSet.Name = "Only" Then
 objSelSet.Delete
 Exit For
 End If
 Next
 Set objSelSet = ThisDrawing.SelectionSets.Add("Only")
 intType(0) = 0  'Фильтры выбора
 varData(0) = "INSERT" '"INSERT"             для выбора блока
 objSelSet.SelectOnScreen intType, varData
 Set SelectOnlyOnScreen = objSelSet
 End Function
 Public Sub BlockCount()
 Dim acSelSet As AcadSelectionSet
 Set acSelSet = SelectOnlyOnScreen
 MsgBox "Найдено блоков: " & CStr(acSelSet.Count) & " шт."
 End Sub

это код, который якобы определяет блоки, но я не до конца представляю как он работает нужен он вообще