[CDR 2017-2021] Поиск незамкнутых кривых в CD 2017

[dastin]

объединить эти два сборника

так wx_Tools уже отредактирован - если прочтете описание его и zzOsmana - то увидите немало совпадений
- надо будет просто его дополнить тем, что wOxxOm видимо решил выбросить
там, сказать прямо, и без этого порядочно навалено всякого ... ну пусть ещё будет маленькая кучка

вижу-вижу ... уже выложили
вечером займусь ... хотя может вы с @_MBK_ ещё код поправите?

 

[_MBK_]

ещё код поправите?

Чего там править если можно сразу готовый адаптировать

 

[dastin]

там всего-то

Sub selectOpenCurves() ' =================================================================================================
   Dim sh As Shape, sr As New ShapeRange
   boostStart
   For Each sh In ActivePage.shapes
      If sh.Type = cdrCurveShape Then If Not sh.Curve.Closed Then sr.Add sh
   Next sh
   ActiveDocument.ClearSelection: ActiveDocument.AddToSelection sr
   boostFinish
End Sub

а у вас разговор за группы пошёл ...?

 

[shakhtar]

там всего-то

Sub selectOpenCurves() ' =================================================================================================
   Dim sh As Shape, sr As New ShapeRange
   boostStart
   For Each sh In ActivePage.shapes
      If sh.Type = cdrCurveShape Then If Not sh.Curve.Closed Then sr.Add sh
   Next sh
   ActiveDocument.ClearSelection: ActiveDocument.AddToSelection sr
   boostFinish
End Sub

а у вас разговор за группы пошёл ...?

Не работает : ошибку VBA выдает

 

[_MBK_]

Без обработки вложенных групп как то так

Sub SelectUnclosedInGroup()
 Dim shRange As ShapeRange
 Dim sh As Shape
 
 Set shRange = ActiveSelectionRange
 If shRange.Count = 0 Or shRange(1).Type <> cdrGroupShape Then
    MsgBox "There is no selected groups in the current document!"
    Exit Sub
 End If
 shRange(1).RemoveFromSelection
 For Each sh In shRange(1).Shapes
  If sh.Type = cdrCurveShape Then
    
  If Not sh.DisplayCurve.Closed Then
    sh.AddToSelection
  End If
  End If
 Next sh


End Sub

А с вложенными не факт что можно вообще

 

[shakhtar]

Без обработки вложенных групп как то так

Sub SelectUnclosedInGroup()
 Dim shRange As ShapeRange
 Dim sh As Shape
 
 Set shRange = ActiveSelectionRange
 If shRange.Count = 0 Or shRange(1).Type <> cdrGroupShape Then
    MsgBox "There is no selected groups in the current document!"
    Exit Sub
 End If
 shRange(1).RemoveFromSelection
 For Each sh In shRange(1).Shapes
  If sh.Type = cdrCurveShape Then
   
  If Not sh.DisplayCurve.Closed Then
    sh.AddToSelection
  End If
  End If
 Next sh


End Sub

А с вложенными не факт что можно вообще

Работает. Но к сожалению без вложенных групп толку от него мало.
Но все равно респект.
В старой версии вроде он опазнавал вложенные.

 

[_MBK_]

В старой версии вроде он опазнавал вложенные.

Код из старой версии вам Дастин тут приводил, там вообще обработки групп нет
Попробуйте убрать booststart и boostfinish и проверьте

 

[dastin]

В старой версии вроде он опазнавал вложенные

где же?
If sh.Type = cdrCurveShape

 

[dastin]

можно выделить все-все-все незамкнутые, но ...
перед этим надо или все группы разгруппировать или эти незамкнутые из этих групп "выдрать" ...
что будет для вас лучше?

 

[_MBK_]

Проверил сам - да, как и предполагал Кэп, работает только с разгруппированными

 

[_MBK_]

А вот так и с вложенными работает

Sub ProcessShape(sr As ShapeRange, sh As Shapes)
   For Each shr In sh
      If shr.Type = cdrCurveShape Then
       If Not shr.Curve.Closed Then sr.Add shr
      Else
       If shr.Type = cdrGroupShape Then ProcessShape sr, shr.Shapes
      End If
      
   Next shr
End Sub

Sub selectOpenCurves() ' =================================================================================================
   Dim sh As Shape, sr As New ShapeRange
   ProcessShape sr, ActivePage.Shapes
  
   ActiveDocument.ClearSelection: ActiveDocument.AddToSelection sr
 
End Sub

 

[shakhtar]

А вот так и с вложенными работает

Sub ProcessShape(sr As ShapeRange, sh As Shapes)
   For Each shr In sh
      If shr.Type = cdrCurveShape Then
       If Not shr.Curve.Closed Then sr.Add shr
      Else
       If shr.Type = cdrGroupShape Then ProcessShape sr, shr.Shapes
      End If
   
   Next shr
End Sub

Sub selectOpenCurves() ' =================================================================================================
   Dim sh As Shape, sr As New ShapeRange
   ProcessShape sr, ActivePage.Shapes
 
   ActiveDocument.ClearSelection: ActiveDocument.AddToSelection sr
 
End Sub

PS кстати в 12й версии ,старый макрос с вложенными работает.

 

[_MBK_]

старый макрос с вложенными работает

Значит это другой макрос, приведенный выше кусок кода никак с группами работать не может по определению

 

[dastin]

кстати в 12й версии ,старый макрос с вложенными работает

давайте проверим ...
кривую незамкнутую и замкнутую сгруппируйте, скопируйте и снова сгруппируйте - будет 4 объекта, из них 2 незамкнутых
запомните что вы вызываете из 12 Корела - название макроса и пункт в нём

 

[shakhtar]

давайте проверим ...
кривую незамкнутую и замкнутую сгруппируйте, скопируйте и снова сгруппируйте - будет 4 объекта, из них 2 незамкнутых
запомните что вы вызываете из 12 Корела - название макроса и пункт в нём

Ну что, я не знаю как проверять ,что ли ? Многоуровневую группировку делал - все работает.
Вот ,если ничего не напутал ,код :
Sub selectOpenCurves()
Dim sh As Shape, sr As New ShapeRange
boostStart
For Each sh In ActivePage.FindShapes(, cdrCurveShape)
If sh.Type = cdrCurveShape Then If Not sh.Curve.Closed Then sr.Add sh
Next sh
ActiveDocument.ClearSelection: sr.CreateSelection
boostFinish
End Sub

 

[_MBK_]

А! Ну такой код и у меня выделяет вложенные, он даже проще, чем мой
Вся фишка в том что FindShapes пофиг на группы оказывается можно их не перебирать
Видимо в сообщении #23 неверно скопировался

 

[dastin]

Видимо в сообщении #23 неверно скопировался

ни-ни ... zz.rar\zzOsman2.gms /// другой, который не 2, я ещё не смотрел ...
да-а ... там похоже винегрет с оливье под шубой

 

[_MBK_]

ни-ни ... zz.rar\zzOsman2.gms /// другой, который не 2, я ещё не смотрел ...
да-а ... там похоже винегрет с оливье под шубой

Ну лично у меня вот такой код

Sub selectOpenCurves()
Dim sh As Shape, sr As New ShapeRange

For Each sh In ActivePage.FindShapes(, cdrCurveShape)
If sh.Type = cdrCurveShape Then If Not sh.Curve.Closed Then sr.Add sh
Next sh
ActiveDocument.ClearSelection: sr.CreateSelection

End Sub

выделяет все, включая вложенные

 

[dastin]

уф ... собрал из двух османов одного ... кое-что придется предать забвению
типа
загрузить цветовой профиль "Silko"
загрузить цветовой профиль "Swop2"
загрузить палитру "Summer" по пути C:\Programm Files\CorelDRAW 12 ////
CurveChannelMixer молодой как Буратино - без движков и красоты - простое окно c textbox-ами
TransformEach - упоминание есть ... а всё остальное пошло за молоком
TougleView
...
все равно остается МНОГА!
пихать всё это в wx_Tools /// ой, не знаю ... монстра получится ... хоть там пересечений немало
- и надо ещё декларации сравнить на предмет переменных

 

[dastin]

Ну что, я не знаю как проверять ,что ли ?

Проверяйте ... zOsman3.gms
оставил отдельным сборником - не стал соединять и воплощать ... по крайней мере пока