• alexul
  • Восстановленный участник
  • На форуме с 23 ноября 2006г.
  • Сообщений: 7
  • Спасибо: 0

Тема: Как выделить обьект на layout

Как программно осуществить выделение обьекта?
Этот код почему-то не работает :(

Set ssetobj = ThisDrawing.SelectionSets.Add("my_select3")
Set ssobjs(0) = ThisDrawing.Blocks(1).Layout.Block.Item(3)
ssetobj.AddItems ssobjs
ssetobj.Update

Проходит без ошибок, но ничего не выделяется - нет синей рамки вокруг обьекта, когда повторно вызываешь его - говорит что выделение с таким именем "my_select3" уже есть:(

  • brigval
  • brigval
  • Активный участник
  • Откуда: Подмосковье
  • На форуме с 11 декабря 2001г.
  • Сообщений: 2,315
  • Спасибо: 1

Re: Как выделить обьект на layout

Кажется, выделить объект так, чтоб появились ручки, можно только вручную. Попробуйте выделять нужный объект цветом.
SelectionSets предназнчен для сбора и хранения объектов. Насколько я в курсе. Но не для их выделения.

  • kpblc
  • kpblc
  • Активный участник
  • Откуда: С.-Петербург
  • На форуме с 29 ноября 2004г.
  • Сообщений: 8,348
  • Спасибо: 24

Re: Как выделить обьект на layout

Если надо именно "подсветить" набор (и highligh, и grips ему), то по поиску в форуме, через SendCommand("(sssetfirst selset selset)") или что-то такого типа - решение будет найдено.

  • alexul
  • Восстановленный участник
  • На форуме с 23 ноября 2006г.
  • Сообщений: 7
  • Спасибо: 0

Re: Как выделить обьект на layout

Большое спасибо! все сделал

  • alexul
  • Восстановленный участник
  • На форуме с 23 ноября 2006г.
  • Сообщений: 7
  • Спасибо: 0

Re: Как выделить обьект на layout

Может кому пригодится: реализовал поиск текста (mtext, text) по подстроке во всех лэйаутах (цикл по всем обьектам лэйаута), простенький интерфейс, возможность перехода на найденный элемент - он становиться подсвеченным (highlight) и выбранным (grips), его видно на экране (на него позиционируется рабочее окно).

Private Sub find_substr()
Dim spaceBlk As AcadBlock
Dim my_mtxt As AcadMText
Dim my_txt As AcadText
If TextBox1.Text = "" Then Exit Sub
ListView1.ListItems.Clear
find_str = LCase(TextBox1.Text)
For i = 1 To ThisDrawing.Blocks.Count - 1
    If ThisDrawing.Blocks(i).IsLayout = True Then
        my_space = ThisDrawing.Blocks(i).Layout.Name
        Set spaceBlk = ThisDrawing.Blocks(i).Layout.Block
        For j = 0 To spaceBlk.Count - 1
            If TypeOf spaceBlk.Item(j) Is AcadMText Then
                    Set my_mtxt = spaceBlk.Item(j)
                    my_str = LCase(my_mtxt.TextString)
                    If InStr(1, my_str, find_str) > 0 Then
                        Set my_lst = ListView1.ListItems.Add(, , my_space)
                        my_lst.SubItems(1) = my_str
                        my_lst.SubItems(2) = i
                        my_lst.SubItems(3) = j
                    End If
            End If
            If TypeOf spaceBlk.Item(j) Is AcadText Then
                    Set my_txt = spaceBlk.Item(j)
                    my_str = LCase(my_txt.TextString)
                    If InStr(1, my_str, find_str) > 0 Then
                        Set my_lst = ListView1.ListItems.Add(, , my_space)
                        my_lst.SubItems(1) = my_str
                        my_lst.SubItems(2) = i
                        my_lst.SubItems(3) = j
                    End If
            End If
        Next j
    End If
Next i
End Sub
'================================
'================================
Private Sub CommandButton1_Click()
find_substr
End Sub
Private Sub CommandButton2_Click()
Dim my_mtxt As AcadMText
Dim ssobjs(0) As AcadEntity
Dim ssetobj As AcadSelectionSet
Dim selset As AcadSelectionSet
If ListView1.ListItems.Count = 0 Then Exit Sub
i = ListView1.SelectedItem.Index
List_name = ListView1.SelectedItem.Text
ThisDrawing.WindowState = acMax
Set my_mtxt = ThisDrawing.Blocks(Val(ListView1.ListItems(i).SubItems(2))).Layout.Block.Item(Val(ListView1.ListItems(i).SubItems(3)))
my_mtxt.GetBoundingBox minp, Maxp
v = ThisDrawing.Blocks(Val(ListView1.ListItems(i).SubItems(2))).Layout.Block.Item(Val(ListView1.ListItems(i).SubItems(3))).Handle
ThisDrawing.SendCommand "(setq ss (ssadd))" + vbCr
ThisDrawing.SendCommand "(ssadd (handent """ + v + """) ss)" + vbCr
ThisDrawing.SendCommand "(sssetfirst ss ss)" + vbCr
ThisDrawing.ActiveLayout = ThisDrawing.Layouts(List_name)
Application.ZoomWindow minp, Maxp
ThisDrawing.Regen acAllViewports
ThisDrawing.SendCommand "REGEN" + vbCr
ThisDrawing.Regen acAllViewports
End
End Sub
'================================
'================================
Private Sub ListView1_DblClick()
If ListView1.ListItems.Count = 0 Then Exit Sub
CommandButton2_Click
End Sub
'================================
'================================
Private Sub UserForm_Activate()
ListView1.View = lvwReport
ListView1.LabelEdit = lvwManual
ListView1.GridLines = True
ListView1.ColumnHeaders.Add Text:="Лист"
ListView1.ColumnHeaders.Add Text:="Текст", Width:=600
ListView1.ColumnHeaders.Add Text:="N1"
ListView1.ColumnHeaders.Add Text:="N2"
ListView1.ColumnHeaders(3).Width = 10
ListView1.ColumnHeaders(4).Width = 10
End Sub

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

Re: Как выделить обьект на layout

А вообщем опять, без использования возможностей LISP'а - не получается... Впечатление, что все время ходим по одним и тем же, если не граблям, то - колеям, изобретаем perpetuum module.
Может, вместо ругательского "FAQ" ввести на форуме раздел: "Вечнозеленые темы"?