Zobacz temat - Makro do grupowania obiektów wewnątrz warstw

Corel FORUM
Forum użytkowników programów firmy Corel. Grafika wektorowa, rastrowa i obróbka zdjęć cyfrowych

Makra - Makro do grupowania obiektów wewnątrz warstw

TheMan258 - 22 Luty 2021, 16:47
Temat postu: Makro do grupowania obiektów wewnątrz warstw

Witam wszystkich,
Potrzebuję porady, pracuje w Corelu x5 i mam napisane różne makra, z których korzystam, na co dzień. Mam makro, które rozdziela obiekty na osobne warstwy następnie je sobie rozgrupowuję i np. zmieniam coś w tej rozgrupowanej grupie. I tu mam problem, ponieważ potrzebowałbym takie makro, które zgrupuje wszystkie te obiekty, ale w taki sposób, aby te kształty zostały w swoich warstwach tak jak w załączniku. (Makro które grupuje obiekty wewnątrz warstw)
Mam takie makro, ale działa tylko wtedy gdy warstwa nazywa się ,,Warstwa 1,,.
Nie wiem, czy dobrze myślę, ale próbowałem coś takiego dopisać

Kod:

( "Warstwa_" &)

jednak to nie działa.

Kod:

Sub Grupowanie()
Dim sr As ShapeRange, s As Shape
Set sr = ActivePage.Layers("Warstwa 1").Shapes.All
If sr.count = 0 Then MsgBox "Żaden kształt nie jest zaznaczony": Exit Sub
Set s = sr.Group
End Sub

Czasem mam 100 warstw z kształtami i zajmuje mi to trochę czasu zgrupować te wszystkie obiekty. Byłbym bardzo wdzięczny o wskazanie sposobu, w jaki sposób taką operację przeprowadzić.

maroQ - 27 Czerwiec 2021, 22:12

Rozumiem, że używasz pętli dla warstw. W takim przypadku należy jeszcze aktywować warstwę na której się operuje w przeciwnym wypadku zawsze pracujemy na aktywnej. Alternatywnie po zgrupowaniu można obiekty przenieść na inną warstwę.

Kod:

Sub GroupAllOnPage()
Dim sr As ShapeRange, s As Shape
Dim l As Layer
Dim info As String

For Each l In ActivePage.Layers
If l.IsDesktopLayer Or l.IsSpecialLayer Or l.IsGridLayer Or l.IsGuidesLayer Or l.Editable = False Then
GoTo skip
End If
l.Activate

Set sr = l.Shapes.All
If sr.Count = 0 Then
info = info & "Na warstwie " & l.Name & " nie znaleziono obiektow!" & vbNewLine
ElseIf sr.Count = 1 Then
If sr.Item(1).Type = cdrGroupShape Then
info = info & "Obiekty na warstwie " & l.Name & " zostaly uprzednio zgrupowane" & vbNewLine
Else
info = info & "Na warstwie " & l.Name & " byl tylko jeden obiekt wiec nie zostal zgrupowany" & vbNewLine
End If
Else
Set s = sr.Group
info = info & "Zgrupowano " & sr.Count & " krzywych na warstwie " & s.Layer.Name & vbNewLine
's.MoveToLayer l
End If
skip:
Next l

W edytorze VBA odpal CTRL+G lub Immediate Windows z menu View by zobaczyć konsolę.

Makro pomija warstwy specjalne oraz nieedytowalne.

Linijka: Set s = sr.Group jest zbędna gdyż sr.Group nie wymaga przypisania do zmiennej. Jednak zostawiłem ją dla celów diagnostycznych by podglądać na jakiej warstwie leży nasz kształt s.

TheMan258 - 18 Wrzesień 2021, 12:45

Dziękuję bardzo, makro wspaniale działa :dances