• Dimasm
  • Восстановленный участник
  • На форуме с 21 февраля 2007г.
  • Сообщений: 4
  • Спасибо: 0

Тема: Пробежаться циклом по всем объектам чертежа...

Задача такова. Есть простенький рисунок.
Состоит из 4-х видов объектов
- линия (line)
- окружность (circle)
- точка (point)
- регион (region)
Нужно пробежать циклом по всем этим объектам
и получить свойства - если это линия,то координаты начала и конца, толщину. если окружность - координты центра, диаметр и толщину линии, и.т.д
и дальше, например вывести в TextBox на форме
как я понимаю, должно быть примерно так

Dim allObjs AS ????
Dim allObj AS ????
Set allObjs = ThisDrawing.?????? (AllObjects)
For each allObj in allObjs
   if allObj.Type = atLine then _
      TextBox.Text = TextBox.Text+allObj.???.X
      ...
   if allObj.Type = atCircle then _
      TextBox.Text = TextBox.Text+allObj.???.X
      ...
Next

Я написал как бы мне хотелось... а как это выглядит в реале - догнать не получается
Пробовал через SelectionSets...
не то, да и не могу к координатам подлезть
По форуму полазал - ответа для себя не нашёл
Подскажите чем заменить вопросы :)

  • Boxa
  • Восстановленный участник
  • На форуме с 16 августа 2005г.
  • Сообщений: 60
  • Спасибо: 0

Re: Пробежаться циклом по всем объектам чертежа...

А отладка зачем существует?
Да и хелп по объектам вполне понятный.
могу только сказать что координаты этих объектов представленны массивом координат.

  • Dimasm
  • Восстановленный участник
  • На форуме с 21 февраля 2007г.
  • Сообщений: 4
  • Спасибо: 0

Re: Пробежаться циклом по всем объектам чертежа...

мде...
как получить все объекты я догнал

    Dim cLine   As AcadLine
    Dim cCircle As AcadCircle
    Dim cRegion As AcadRegion
    Dim cPoint  As AcadPoint
    For i = 0 To ThisDrawing.ModelSpace.Count - 1
        MsgBox ThisDrawing.ModelSpace.Item(i).ObjectName
        'AcDbLine
        If ThisDrawing.ModelSpace.Item(i).ObjectName = "AcDbLine" Then
            Set cLine = ThisDrawing.ModelSpace.Item(i)
        End If
        'AcDbCircle
        'AcDbRegion
        'AcDbPoint
    Next i

а как к координатам точек, например, линии подобраться?
пробовал
так
    Dim St(3) As Double
    St = cLine.StartPoint
не выходит.
Подскажите что не так?

  • Gogi
  • Восстановленный участник
  • На форуме с 25 мая 2004г.
  • Сообщений: 136
  • Спасибо: 0

Re: Пробежаться циклом по всем объектам чертежа...

Dim St As Variant
St = cLine.StartPoint

или

Dim St(0 To 2) As Double
St = cLine.StartPoint

  • Dimasm
  • Восстановленный участник
  • На форуме с 21 февраля 2007г.
  • Сообщений: 4
  • Спасибо: 0

Re: Пробежаться циклом по всем объектам чертежа...

Godi - спасибо большое. Я слабоват в Basic. Прокатил первый вариант.
И появились пара новых вопросов
Вот код к которому я пришёл...

...
Function GetCircleData(cCircle As AcadCircle, result As String)
    Dim St As Variant
    St = cCircle.Center
    GetCircleData = "Circle:" & St(0) & "-" & St(1) & ";" _
                          & cCircle.Radius & ";" & _
                          cCircle.Lineweight & "#"
    GetCircleData = result + GetCircleData
End Function
'================================
Function GetRegionData(cRegion As AcadRegion, result As String)
    ????????
    ????????
    GetRegionData = result + GetRegionData
End Function
'================================
Function GetPointData(cPoint As AcadPoint, result As String)
    Dim pt As Variant
    pt = cPoint.Coordinates
    GetPointData = "Point:" & pt(0) & "-" & pt(1) & "#"
    GetPointData = result + GetPointData
End Function
'================================
Private Sub CommandButton1_Click()
    Dim cLine     As AcadLine
    Dim cCircle   As AcadCircle
    Dim cRegion   As AcadRegion
    Dim cPoint    As AcadPoint
    Dim cPolyline As AcadPolyline
    Dim result    As String
    For i = 0 To ThisDrawing.ModelSpace.Count - 1
        'AcDbLine
        .....
        'AcDbCircle
        If ThisDrawing.ModelSpace.Item(i).ObjectName _
            = "AcDbCircle" Then
            Set cCircle = ThisDrawing.ModelSpace.Item(i)
            result = GetCircleData(cCircle, result)
        End If
        'AcDbRegion
        If ThisDrawing.ModelSpace.Item(i).ObjectName _
            = "AcDbRegion" Then
            Set cRegion = ThisDrawing.ModelSpace.Item(i)
            result = GetRegionData(cRegion, result)
        End If
        'AcDbPoint
        If ThisDrawing.ModelSpace.Item(i).ObjectName _
            = "AcDbPoint" Then
            Set cPoint = ThisDrawing.ModelSpace.Item(i)
            result = GetPointData(cPoint, result)
        End If
        'AcDbPolyline
        If ThisDrawing.ModelSpace.Item(i).ObjectName _
            = "AcDbPolyline" Then
            Set cPolyline = ThisDrawing.ModelSpace.Item(i)
            'result = GetPolylineData(cPolyline, result)
        End If
        ListBox1.AddItem result
        result = ""
    Next i
End Sub

Вопрос 1:
Как мне подобраться к координатам точек объекта AcadRegion?
там нет ни Coordinate ни StartPoint... просмотр описания его свойств и методов ничего не прояснил
Вопрос 2:
при попытке выполнить код

Set cPolyline = ThisDrawing.ModelSpace.Item(i)

вылетает ошибка Run-time error '13'. Type mismatch
Несоответстви типов. Всё делал по аналогии с другими объектами.
как сделать правильно?

  • Gogi
  • Восстановленный участник
  • На форуме с 25 мая 2004г.
  • Сообщений: 136
  • Спасибо: 0

Re: Пробежаться циклом по всем объектам чертежа...

[rus]Polilinii byvajut raznye. Posmotri v helpe.
[/rus]
Acad3DPolyline
AcadLWPolyline
[rus] U regiona est' metod
[/rus]Explode, [rus] kotoryjj vozvrashaet vhodjashhie ob''ekty. U kotoryh mozhno posmotret' koordinaty, a potom blagopoluchno udalit'.
[/rus]