Corel FORUM

[marek_maro]

Witam, czy dałoby radę stworzyć makro które brało by kolejne obiekty położone jeden na drugim i umieszczało (środkowało w pionie i poziomie) je w kwadratach.

Może obrazowo to lepiej będzie tłumaczyć o co mi chodzi :)

[Shame]

Zaznacz najpierw "koło", potem "kwadrat" a potem naciśnij C, a potem E (lub E > C, obojętnie).

Wyjaśniam: najpierw zaznaczasz obiekt przesuwany, a potem zaznaczasz obiekt, względem którego ma być rozmieszczony ten pierwszy. Skrót C podczas zaznaczenia obu obiektów środkuje w pionie, podczas kiedy E - w poziomie.

Odnośnie makra, to rozumiem, że chodzi o dużo elementów, które mają trafić do wielu kwadratów? To mógłbyś nagrać takie zaznaczanie i środkowanie, a potem wrzucić to w pętlę. Chociaż trzeba by pokombinować jak to zrobić, żeby zaznaczał kolejne elementy i kolejne kwadraty... Ale pewno jest to do zrobienia.

[marek_maro]

Można powiedzieć, że dokładnie taką samą teorię mam w głowię jednak chodzi o "automatykę" tego co miałbym zrobić ręcznie i zaoszczędzenie trochę czasu ;)

[maroQ]

Najprościej z punktu widzenia kodu to wygląda tak:

Kod:

Sub PutCircleIntoRect()     On Error GoTo theend         CorelDRAW.Optimization = True     ActiveDocument.BeginCommandGroup "PutCircleIntoRect"     Dim circles As ShapeRange     Dim rects As ShapeRange         Set circles = ActiveLayer.FindShapes(Type:=cdrEllipseShape)     Set rects = ActiveLayer.FindShapes(Type:=cdrRectangleShape)         If circles.Count = 0 Then Exit Sub     If rects.Count = 0 Then Exit Sub             Dim cnt As Integer, i As Integer     If circles.Count > rects.Count Then         cnt = rects.Count     Else         cnt = circles.Count     End If                 For i = 1 To cnt         With rects(i)             circles(i).SetPosition .PositionX + .SizeWidth / 2 - circles(i).SizeWidth / 2, .PositionY - .SizeHeight / 2 + circles(i).SizeHeight / 2         End With     Next i     theend:     ActiveDocument.EndCommandGroup     CorelDRAW.Optimization = False     CorelDRAW.Refresh         If Err.Description <> "" Then         MsgBox "Wystąpił błąd: " & Err.Description, vbCritical, Err.Source     Else         MsgBox "Zadanie wykonane!", vbInformation, "Sukces!"     End If End Sub

Działa tylko na elipsach i prostokątach, nie skaluje i nie sprawdza wymiarów.
SOA#1 jeśli coś jest nie tak to pewnie coś źle dodałem lub odjąłem.

Grupowanie i optymalizację polecam używać tak jak napisałem w kodzie tj. z etykietą theend bo jeśli wystąpi błąd w kodzie i makro się zatrzyma i bez odpalenia edytora vba i wywołania zakończenia optymalizacji konieczne będzie zamknięcie Corela. Najwięcej problemów sprawia zagnieżdżone grupowanie które bardzo miesza w Corelu i ciężko później pracować. Trzeba więc pamiętać by:

[marek_maro]

Bardoz dziękuję dzisiaj przetestuje makro :)

[tomek123]

Rozkłada dowolne obiekty (zaznaczone) na osi X od lewej do prawej w kolejności wysokości na warstwie (od najniższego obiektu do najwyższego albo na odwrót, nieistotne)
Przyda się może bardziej, niż to zadanko w zapytaniu.
Ja używam bardzo często, np. importuję sobie 10 plików png w jedno miejsce, a potem rozkładam w poziomie, dla podglądu.
Nie wiem, dlaczego w standardzie Corel nie ma takiej funkcjonalności, bardzo podstawowa (a może ma?!?, nie szukałem tak dokładnie)

Kod:

'Rozłożenie zaznaczonych obiektów na osi X Public Sub Spread_shapes() Dim s As Shape, i As Integer, w As Double, x As Double, y As Double    If ActiveSelection.SizeWidth = 0 Then       MsgBox "Zaznacz obiekty do rozlozenia!!!"    Exit Sub Optimization = True i = 0 For Each s In ActiveSelection.Shapes     If i > 0 Then         x = (x + w)         s.SetPosition x, y         w = s.SizeWidth     Else         y = s.PositionY         x = s.PositionX         w = s.SizeWidth     End If     i = i + 1 Next Optimization = False ActiveWindow.Refresh End Sub

A poniższy kod rozkłada obiekty wg założeń z tego tematu, więc zaznaczone obiekty wrzuca w ramki
- zbyt mało było założeń w pytaniu, więc ustaliłem, że ramka to każdy niewypełniony prostokąt w dokumencie, makro obsługuje do 999 ramek w dokumencie, co mozna oczywiście zwiekszyć, ale chyba nie ma takiej konieczności
- założyłem, że ramki to nie krzywe, tylko każdy zwykły niewypełniony prostokąt o dowolnym rozmiarze, piszę bo wiem, że niektórzy maja z tym problem;)
- makro nie dopasowuje rozmiarów zaznaczonych obiektów do ramki, tylko je centruje, takie były dane w temacie.
- jeżeli zaznaczony obiekt jest zgrupowany, to traktuje go jako jeden obiekt (to chyba bardziej funkcjonalne, choc można to zmienić)

Kod:

'Rozłożenie zaznaczonych obiektów w prostokatach bez wypełnienia (ramki) Public Sub Spread_shapes_in_rectangle() Dim s As Shape, sr As ShapeRange, i As Integer, j As Integer, x As Double, y As Double If ActiveSelection.SizeWidth = 0 Then     MsgBox "Zaznacz obiekty do rozlozenia w ramkach!!!"     Exit Sub End If Set sr = ActivePage.Shapes.FindShapes(Query:="@type = 'rectangle' and @fill.type = 'none'") If sr.count = 0 Then     MsgBox "Brak ramek w dokumencie." & vbCr & "Stwórz za pomoca narzedzia prostokat [F6] i nie wypalniaj kolorem."     Exit Sub End If Optimization = True i = 0 For Each s In sr     s.name = "ramka" & Format(i, "000")     s.OrderToBack     i = i + 1 Next s j = 0 For Each s In ActiveSelection.Shapes.All     If j = i Then         MsgBox "Za malo ramek na zaznaczone obiekty!!!"         GoTo door:     End If     Set sr = ActivePage.Shapes.FindShapes(Query:="@name = '" & "ramka" & Format(j, "000") & "'")     x = sr.CenterX     y = sr.CenterY     s.CenterX = x     s.CenterY = y     j = j + 1 Next door: Optimization = False ActiveWindow.Refresh End Sub

[tegraf]

A to makro nie może sobie samo narysować brakujących ramek? Zmuszanie użytkownika który chce w ten sposób rozmieścić 300 elementów do narysowania 300 prostokątów - nie wygląda dobrze. Narysowanie niewypełnionego prostokąta przez makro w odpowiednim momencie nie powinno stanowić problemu.

[tomek123]

To nie jest problem, tylko założyłem, że autor tematu ma już ramki, więc nie chciałem być nadgorliwy ;) Dodatkowo nie napisał jak mają one być rozłożone i jakie maja mieć wymiary, więc stwierdziłem, że sam sobie to zrobi, skoro to nie gra roli.

Stworzenie prostokąta to metoda 'CreateRectangle' - wystarczy dołożyć do kodu i uruchomić warunkowo, jak brakuje ramek...

Jak chcesz takie makro, to jak będe miał chwilkę czasu to je rozbuduję...

[tegraf]

[chezare]

Każdy obrazek w Corelu da się narysować makrem, ciekawe dlaczego ludzie tak nie robią?