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 400 raz(y) 113.12 KB

test forum Corel.jpg

Pobierz Plik ściągnięto 426 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

[Martin Nez]

Witam,
wiem, że późno odświeżam, ale może komuś się przyda. Trochę krótsza i chyba prostsza wersja.

Kod:

Sub michals()     ActiveLayer.Shapes.All.CreateSelection     ActiveLayer.Shapes.FindShapes(, cdrGroupShape).RemoveFromSelection     ActiveSelection.Group End Sub

Pozdr,
MN