• A32978
  • Восстановленный участник
  • На форуме с 15 августа 2008г.
  • Сообщений: 34
  • Спасибо: 0

Тема: Порядок следования на VBA

Как изменить порядко следования приммитивов с помощью команд VBA? Где то я это уже видел но хоть абстенку разбейся через этот поиск найти немогу. Подскажите пожалуйста.

  • A32978
  • Восстановленный участник
  • На форуме с 15 августа 2008г.
  • Сообщений: 34
  • Спасибо: 0

Re: Порядок следования на VBA

Вот способ поднять блоки с определенным именем
ReDim Preserve gpCode(1) As Integer
ReDim Preserve dataValue(1) As Variant
gpCode(0) = 0
dataValue(0) = "INSERT"
gpCode(1) = 2
dataValue(1) = "2g_003"
Set sSetObj = ThisDrawing.SelectionSets.Add("GOOselection_015das222d16abw")
sSetObj.Select acSelectionSetAll, , , gpCode, dataValue
j = 0
Do While j < sSetObj.Count
    sSetObj.Item(j).Copy
    sSetObj.Item(j).Delete
    j = j + 1
Loop
sSetObj.Delete
Но как опустить??? тоже самое проделать с остальными?? помоему это не правильно

  • Откуда: Украина / Киев
  • На форуме с 15 апреля 2005г.
  • Сообщений: 8,666
  • Спасибо: 158

Re: Порядок следования на VBA

В справке смотри SortentsTable, ее методы: MoveAbove, MoveBelow, MoveToBottom, MoveToTop и примеры к ним.

  • A32978
  • Восстановленный участник
  • На форуме с 15 августа 2008г.
  • Сообщений: 34
  • Спасибо: 0

Re: Порядок следования на VBA

Александр Ривилис - СПАСИБО!
вот что у меня получилось
ReDim Preserve gpCode(1) As Integer
ReDim Preserve dataValue(1) As Variant
gpCode(0) = 0
dataValue(0) = "INSERT"
gpCode(1) = 2
dataValue(1) = "2g_003"
Set sSetObj = ThisDrawing.SelectionSets.Add("GOOselection_015das222d16abw")
sSetObj.Select acSelectionSetAll, , , gpCode, dataValue
Dim eDictionary As Object
Set eDictionary = ThisDrawing.ModelSpace.GetExtensionDictionary
Dim sentityObj As Object
Dim arr(0) As AcadObject
j = 0
Do While j < sSetObj.Count
    Set sentityObj = eDictionary.GetObject("ACAD_SORTENTS")
    On Error GoTo 0
    If sentityObj Is Nothing Then
         Set sentityObj = eDictionary.AddObject("ACAD_SORTENTS", "AcDbSortentsTable")
    End If
    Set arr(0) = sSetObj.Item(j)
    sentityObj.MoveToTop arr
    AcadApplication.Update
    j = j + 1
Loop
sSetObj.Delete
код найдет все блоки с именем "2g_003" и подымет их наверх
КОМУ НАДО ЮЗАЙТЕ! =)