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

Тема: ПРОБЛЕМА С КРУГАМИ.....

Уважаемые знатоки,
у меня появилась проблема такого рода
мне нужно было выделить блоки и потом узнать если он круг то получить координаты его центра.
на последней стадии выдает ошибку.
до этого я создал блок только с одним кругом.
Sub change_insertion_point()
    For Each objSelSet In ThisDrawing.SelectionSets
        If objSelSet.Name = "55" Then
            ThisDrawing.SelectionSets.Item("55").Delete
          Exit For
      End If
    Next
    Set Sel = ThisDrawing.SelectionSets.Add("55")
    Dim FilterType(0) As Integer
    Dim FilterData(0) As Variant
    FilterType(0) = 0
    FilterData(0) = "INSERT"
    Sel.SelectOnScreen FilterType, FilterData
    Dim blockObj As AcadBlock
    For Each Sel_Items In Sel
        Sel_ExObj = Sel_Items.Explode
        For i = 0 To UBound(Sel_ExObj)
            If Sel_ExObj(i).ObjectName = "AcDbCircle" Then
                MsgBox Sel_ExObj(i).ObjectName
                MsgBox Sel_ExObj(i).Handle
                MsgBox Sel_ExObj(i).Center(0)
            End If
        Next
    Next
End Sub
есть вероятность что это просто ужасно легкая ошибка потому что в другой программе я выделив круг могу получить его координаты. но разницу во втором случае в том что я определил объект с которого я беру координаты as AcadCircle, но во втором случае он выдал ошибку.
помогите пожалуйста в решении этой проблемы.
первые и сообшения выходят а третий нет
заранее благодарен
саша

  • LeonidSN
  • Активный участник
  • На форуме с 30 мая 2005г.
  • Сообщений: 1,480
  • Спасибо: 5

Re: ПРОБЛЕМА С КРУГАМИ.....

Sub change_insertion_point()
    Dim objSelSet As AcadSelectionSet
    For Each objSelSet In ThisDrawing.SelectionSets
        If objSelSet.Name = "55" Then
            ThisDrawing.SelectionSets.Item("55").Delete
            Exit For
        End If
    Next
    Set objSelSet = ThisDrawing.SelectionSets.Add("55")
    Dim FilterType(0) As Integer
    Dim FilterData(0) As Variant
    FilterType(0) = 0
    FilterData(0) = "INSERT"
    objSelSet.SelectOnScreen FilterType, FilterData
    Dim blockObj As AcadBlock
    Dim Sel_Items As AcadEntity
    Dim Sel_ExObj As Variant
    Dim objCircle As AcadCircle
    Dim i As Integer
    On Error Resume Next
    For Each Sel_Items In objSelSet
        Sel_ExObj = Sel_Items.Explode
        For i = 0 To UBound(Sel_ExObj)
            If Sel_ExObj(i).ObjectName = "AcDbCircle" Then
                Set objCircle = Sel_ExObj(i)
                MsgBox objCircle.ObjectName
                MsgBox objCircle.Handle
                MsgBox objCircle.Center(0)
            End If
        Next i
    Next Sel_Items
End Sub

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

Re: ПРОБЛЕМА С КРУГАМИ.....

доброе утро знатоки!
Вам LeonidSN больщое спасибо за помощь.
этот этап моей программы пройден с Вашеу помощью.
буду продвигаться далее.
спасибо
саша

  • LeonidSN
  • Активный участник
  • На форуме с 30 мая 2005г.
  • Сообщений: 1,480
  • Спасибо: 5

Re: ПРОБЛЕМА С КРУГАМИ.....

> Саша
Если чем-то помог, то рад.
Но я хотел бы обратить твое внимание на оформление кода. В сущности, я не написал ничего нового, просто причесал твою программку.
Соблюдай правила, это помогает, когда надо разобраться в собственной писанине, а уж когда выставляешь на всеобщее обозрение...
Вообщем, успехов!