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

[_MBK_]

кроме таблички с ошибкой никакой индикации. как подсвечивать ошибочную строку в редакторе?

А попробуйте пошагово

 

[DukereD]

кроме таблички с ошибкой никакой индикации. как подсвечивать ошибочную строку в редакторе?

при ошибке жмем Debug и ставим точку остановки на строчку выше ))

 

[_MBK_]

Добрался до корела, вот так работает

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]

Добрался до корела, вот так работает

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_]

sort неприменима в данном случае.

Применима, но придется Shapes переписывать в сортируемую коллекцию, а это лополнительный цикл, за который можно и без него максимум посчитать, но по мне так проще именно так. Вдобавок, этим способом будут отсеяны рамки, не перекрывающие группу

 

[lev]

Не понял про дополнительный цикл

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

 

[_MBK_]

Set ss = sp.Shapes.All

У меня эта конструкция ошибку вызывает

 

[lev]

Какую? Несовпадение типов?
протестировано и работает в X7

 

[tohaa]

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

 

[_MBK_]

если элементы группы находятся в габаритах самого большого объекта

Ну так я ж и говорю

этим способом будут отсеяны рамки, не перекрывающие группу