Corel FORUM

michal.s

Dzień dobry.
Mam do Was pytanie, jak zaznaczyć i zgrupować wszystkie elementy nie będące grupami?
Pracuję w Corelu i często korzystam z nagranych makr.
Sprawują się one bardzo dobrze pod warunkiem, że w projekcie wszystko zawiera tą samą strukturę (w tym przypadku dwie grupy i 12 elementów).
Często udaje mi się je zmodyfikować samemu, ale w tym przypadku nie wiem jak to zrobić.
Mam taki przypadek i w nim nagrany kod sprawuje się idealnie.

Kod:

Sub TemporaryMacro()
' Recorded 09.09.2019
ActiveDocument.CreateSelection ActiveLayer.Shapes(14), ActiveLayer.Shapes(13), ActiveLayer.Shapes(12), ActiveLayer.Shapes(11), ActiveLayer.Shapes(10), ActiveLayer.Shapes(9), ActiveLayer.Shapes(8), ActiveLayer.Shapes(7), ActiveLayer.Shapes(6), ActiveLayer.Shapes(5), ActiveLayer.Shapes(4), ActiveLayer.Shapes(3)
ActiveSelection.Group
End Sub

Natomiast wystarczy, że coś zmieni się w strukturze projektu i efekt jest nie do końca taki jak bym tego chciał, a mianowicie
Wystarczy, że zmieni się ilość elementów.

Mam pytanie, jak wyszukać i zgrupować wszystkie elementy nie będące grupami?

test forum Corel_1.jpg

Pobierz Plik ściągnięto 412 raz(y) 113.12 KB

test forum Corel.jpg

Pobierz Plik ściągnięto 438 raz(y) 120.16 KB

michal.s

Widzę że wszyscy zawaleni pracą.
W takim razie zamiast tworzyć coś nowego to może pomożecie mi zmodyfikować poniższy kod.
Dzieło Szamana :-)

kiedyś pomógł mi i zamieścił taki kod do wyszukiwania krzywych.
Ja chciałbym znaleźć wszystkie gruby obiektów na aktywnej warstwie.

Kod:

Sub Find4Nodes2SubPaths()
Dim s As Shape
Dim sr As New ShapeRange

For Each s In ActivePage.Shapes.FindShapes(, cdrCurveShape)
If s.Curve.Nodes.Count = 4 And s.Curve.Segments.Count = 2 Then
sr.Add s
End If
Next s

ActiveSelectionRange.RemoveFromSelection
'ActiveWindow.ActiveView.ToFitShapeRange sr
sr.CreateSelection
'MsgBox "Znaleziono: " & sr.Count & " krzywych o 4 węzłach i 2 podścieżkach", vbInformation, "OK"
End Subb

michal.s

Udało mi się rozgryźć temat zaznaczania grup.
Może się komuś przyda ten prosty kodzik.
Kod zaznacza wszystkie grupy na stronie.

Kod:

Sub SelectGroups()

Dim s As Shape
Dim shp As New ShapeRange

For Each s In ActivePage.Shapes.FindShapes()
If s.Type = cdrGroupShape Then
shp.Add s
End If
Next s

ActiveSelectionRange.RemoveFromSelection
shp.CreateSelection

End Sub

Potem z zaznaczeniem można zrobić wszystko np.
przenieść na warstwę np. Warstwę 2

Kod:

shp.MoveToLayer ActivePage.Layers("Warstwa 2")

usunąć

Kod:

shp.Delete

rozgrupować

Kod:

shp.Ungroup

Pozdrawiam Wszystkich Serdecznie :-)