[CDR 2017-2019] Поиск групп в документе и перекрас наибольшего.

DukereD

Участник
Сообщения
58
Реакции
3
кроме таблички с ошибкой никакой индикации. как подсвечивать ошибочную строку в редакторе?
при ошибке жмем Debug и ставим точку остановки на строчку выше ))
 

_MBK_

Пикирующий бомбардировщик
12 лет на форуме
Сообщения
29 707
Реакции
9 776
Добрался до корела, вот так работает
Код:
Sub Testfind()

  Dim sr As ShapeRange
  Dim spp As Shape
  Dim sr_counter As Long

  Set sr = ActivePage.FindShapes(Type:=cdrGroupShape)


  If sr.Count <> 0 Then

For Each sp In sr
  For Each spp In sp.Shapes
   If spp.SizeWidth = sp.SizeWidth And spp.SizeHeight = sp.SizeHeight Then
    spp.Outline.Color.CMYKAssign 100, 0, 0, 0
    Exit For
    End If
  Next spp
Next sp


  Else
    MsgBox "There are no group on the current page"
  End If
End Sub
 
  • Спасибо
Реакции: tohaa

tohaa

Участник
Топикстартер
Сообщения
117
Реакции
3
Добрался до корела, вот так работает
Код:
Sub Testfind()

  Dim sr As ShapeRange
  Dim spp As Shape
  Dim sr_counter As Long

  Set sr = ActivePage.FindShapes(Type:=cdrGroupShape)


  If sr.Count <> 0 Then

For Each sp In sr
  For Each spp In sp.Shapes
   If spp.SizeWidth = sp.SizeWidth And spp.SizeHeight = sp.SizeHeight Then
    spp.Outline.Color.CMYKAssign 100, 0, 0, 0
    Exit For
    End If
  Next spp
Next sp


  Else
    MsgBox "There are no group on the current page"
  End If
End Sub
отлично работает. Спасибо. видимо sort неприменима в данном случае.
 

_MBK_

Пикирующий бомбардировщик
12 лет на форуме
Сообщения
29 707
Реакции
9 776
sort неприменима в данном случае.
Применима, но придется Shapes переписывать в сортируемую коллекцию, а это лополнительный цикл, за который можно и без него максимум посчитать, но по мне так проще именно так. Вдобавок, этим способом будут отсеяны рамки, не перекрывающие группу
 

lev

Модератор
15 лет на форуме
Сообщения
2 002
Реакции
1 878
Не понял про дополнительный цикл
Код:
Sub Testfind()
  Dim sp As Shape
  Dim sr As ShapeRange
  Dim ss As ShapeRange
 
  Set sr = ActivePage.FindShapes(Type:=cdrGroupShape)

  If sr.Count <> 0 Then
    For Each sp In sr
      Set ss = sp.Shapes.All
      ss.Sort "@shape1.width*@shape1.height < @shape2.width*@shape2.height"
      ss.LastShape.Outline.SetProperties Color:=CreateCMYKColor(100, 0, 0, 0)
    Next sp
  Else
    MsgBox "There are no groups on the current page"
  End If
End Sub
 
  • Спасибо
Реакции: tohaa

lev

Модератор
15 лет на форуме
Сообщения
2 002
Реакции
1 878
Какую? Несовпадение типов?
протестировано и работает в X7
 
  • Спасибо
Реакции: tohaa

tohaa

Участник
Топикстартер
Сообщения
117
Реакции
3
Ну вы даете) оба работают. Первый макрос работает только, если элементы группы находятся в габаритах самого большого объекта. А макрос с сортировкой - в любом случае.
 

_MBK_

Пикирующий бомбардировщик
12 лет на форуме
Сообщения
29 707
Реакции
9 776