Corel FORUM

michal.s

Zwracam się do Was z pytaniem. Czy jest możliwość stworzenia makra, dzięki któremu po wpisaniu w okno dowolnych wymiarów np. 100/230 mm utworzy prostokąt o tych wymiarach?

Cysorz · Wysłany: 1 Marzec 2012, 00:44

A po co Ci makro jak takie okienko masz standardowo na co najmniej dwa sposoby?

chezare · Wysłany: 1 Marzec 2012, 09:17

Oczywiście, że można sobie taką procedurę napisać, mało tego w zasadzie nie jest Ci do tego potrzebna wiedza na temat VBA, tylko tak jak Malutki zauważył, po co?
Takie polecenie wygląda tak:

Kod:

Sub Prostokat()
ActiveLayer.CreateRectangle 0, 0, 5, 5, 20, 20, 20, 20
End Sub

Te liczby to współrzędne wierzchołków i promienia zaokrąglenia poszczególnych narożników.
Zakładając że prostokąt ma być rysowany zawsze w jednym miejscu i ma np. nie mieć zaokrąglonych narożników to i tak trzeba by jeszcze do tej procedury dodać dwa pytania o wymiary, albo stworzyć formularz do ich wpisywania. Takie drobiazgi jak to czy użytkownik wpisał poprawnie liczbę czy dla żartu napisał dupa pomijam.

Sub Prostokąt()
On Error GoTo koniec ' to na wypadek gdyby źle wpisane zostały wymiary
x = InputBox("wpisz szerokość prostokąta w mm") ' pytanie o szerokość
y = InputBox("wpisz wysokość prostokąta w mm") ' pytanie o wysokość
x = x / 25.4: y = y / 25.4 ' z milimetrów trzeba przeliczyć na cale
ActiveLayer.CreateRectangle 0, 0, x, y, 0, 0, 0, 0 ' utworzenie prostokąta
koniec: ' w to miejsce nastąpi skok w razie problemów z utworzeniem prostokąta (createrectangle)
End Sub

Wystarczy skopiować tekst procedury, wcisnąć w Corelu Alt+F11 i wkleić.
Alt+F4 zamknąć okno edytora VBA i z menu Narzędzia->Visual Basic->Odtwórz uruchomić procedurę Prostokąt.
Taka procedura będzie rysowała prostokąt w lewym dolnym rogu kartki o zadanych w milimetrach wymiarach, tylko po co? :-)

Tak to wygląda w maksymalnym uproszczeniu, a przecież prostokąt może mieć jeszcze jakiś kolor konturu, wypełnienia, tip.
Gdyby tych prostokątów miało być 1000 to może miałoby to sens?

michal.s · Wysłany: 1 Marzec 2012, 18:36

Cześć Panowie.
Już wtajemniczam Was w temat :-)

Jak widać poniżej, mam do przygotowania za każdym razem inną siatkę opakowania.
Za każdym razem tworzę ją od podstaw.
Bardzo lubię to robić, ale jest to coraz bardziej monotonne i popełniam ostatnio coraz więcej błędów (RUTYNA czy cuś :-)

)
Wiem, że przez stworzenie odpowiednigo makra można tą pracę zautomatyzować.
Bardzo zaciekawił mnie temat makr i próbuję coś tam stworzyć samemu.
Posiłkuję się zciągawką z makr które nagrywam, potem staram się je wykorzystać.
Niestety Corel nie dysponuje gotowym oknem do stworzenia obiektu i stąd moja PROŚBA o POMOC :-)

chezare · Wysłany: 1 Marzec 2012, 19:40

To teraz nie rozumiem jeszcze bardziej.

michal.s · Wysłany: 1 Marzec 2012, 20:01

dlaczego nie rozumiesz?

Cysorz · Wysłany: 1 Marzec 2012, 21:46

No bo po co Ci makro gdzie musiałbyś wpisywać komendy do utworzenia takowego prostokąta jak możesz to zrobić w którymkolwiek ze standardowych okienek? A włączając przyciąganie do obiektów jednym ruchem umieszczasz go we właściwej pozycji...

michal.s · Wysłany: 1 Marzec 2012, 22:15

Malutki, masz rację. Bardzo łatwo można to przygotować w Corelu tworząc i przyciągając do punktu poszczególne prostokąty. Ale wierz mi, jeżeli przygotowuje się takich siatek dziennie kilkanaście. Zajmuje to troszkę czasu.
Przygotowując makro, "przysłowiowym jednym kliknięciem" będę mógł utworzyć taką siatkę.

Cysorz · Wysłany: 1 Marzec 2012, 22:25

Jak to będziesz mógł to zrobić "jednym kliknięciem"? Przecież za każdym razem musisz wpisać dwa wymiary i potwierdzić - i na pewno jest je wprowadzić łatwiej za pomocą standardowych narzędzi niż makro...
A jak potrzebujesz np. 74 takie same to wpisujesz taką liczbę w okienko duplikacji i po kliknięciu są!

No chyba że potrzebujesz wykonać zupełnie inną operację, ale dobrze by było wtedy ją opisać ;)

michal.s · Wysłany: 1 Marzec 2012, 22:53

Ja to widzę w ten sposób.
Wywołuję okno tworzenia prostokątu dwa razy. Jeden ma wymiar np. wys.100/szer.100 mm, drugi wys.100/szer.200 mm. Chyba, że można w jednym oknie wprowadzić dane do utworzenia dwóch elementów. Następna czynność w makrze to skopiowanie tych prostokątów o 2xszerokość czyli 300 mm. Otrzymuję 4 prostokąty 100/200/100/200. Kolejna czynność to skopiowanie ich o wysokość, czyli 100 mm i zmniejszenie o połowę bazując na dolnej krawędzi skopiowanych prostokątów. Kolejna czynność to powtórzenie w/w czynności tylko w dół i gotowe :-)

Nieźle to sobie wymyśliłem prawda?

chezare · Wysłany: 2 Marzec 2012, 02:17

Zapomniałeś o skrzydełku do sklejania.
Eksperymentowałem w X3 i w takiej wersji jest cdr.

PUDELKO.ZIP

Pobierz Plik ściągnięto 762 raz(y) 13.71 KB

michal.s · Wysłany: 2 Marzec 2012, 03:24

Faktycznie zapomniałem o skrzydełku :->

chezare, przeglądałem plik który załączyłeś i BINGO, to jest to o co mi chodziło.
Teraz widzę, że sam nie był bym w stanie tego zrobić (no ale może :->

)
Jutro tylko dopracuję ostatni bok, bo generuje się jakiś strasznie duży, potem jeszcze skrzydełko, wymiarowanie i czas który spędzałbym na tworzeniu od podstaw siatek, będę mógł spędzić na forum :->

chezare WIELKIE DZIĘKI ZA POMOC
A teraz chyba załużyliśmy na BARDZO GŁĘBOKI SEN (na pewno TY zasłużyłeś :->

)
Dobranoc chezare.

p.s. sprawdzałeś może materiały z wątku "makro data"?

Malutki, to jest właśnie to "jedno kliknięcie" :->

michal.s · Wysłany: 5 Marzec 2012, 23:48

Witam ponownie.
Nawiązując do wcześniejszego tematu, to udało mi się dojść to takiego efektu

Próbowałem już wszystkiego i niestety nie mogę sobie poradzić z wymiarowaniem w makrze, tak jak poniżej.
Czy jest możliwość, żeby tą czynność zautomatyzować?

michal.s · Wysłany: 7 Marzec 2012, 10:53

Znalazłem w sieci cuś takiego, lecz mam problem z wprowadzeniem tego w życie.
Czy mogę prosić o pomoc w modyfikacji poniższego kodu.
W wierszu "Set s = ActiveLayer.CreateLinearDimension" wyskakuje błąd.

Kod:

Sub MakeDimensions()
Dim x As Double, y As Double, sx As Double, sy As Double
Dim pt1 As SnapPoint, pt2 As SnapPoint
Dim s As Shape

ActiveSelection.GetBoundingBox x, y, sx, sy
Set pt1 = CreateSnapPoint(x, y)
Set pt2 = CreateSnapPoint(x + sx, y)
Set s = ActiveLayer.CreateLinearDimension(cdrDimensionHorizontal, pt1, pt2, True, , , cdrDimensionStyleDecimal, Units:=cdrDimensionUnitIN)

s.Dimension.TextShape.SetPosition x + sx / 2, y - 1
Set s = ActiveLayer.CreateLinearDimension
Set pt1 = CreateSnapPoint(x + sx, y)
Set pt2 = CreateSnapPoint(x + sx, y + sy)
Set s = ActiveLayer.CreateLinearDimension(cdrDimensionVertical, pt1, pt2, True, , , cdrDimensionStyleDecimal, Units:=cdrDimensionUnitIN)
s.Dimension.TextShape.SetPosition x + sx + 1, y + sx / 2
End Sub

chezare · Wysłany: 8 Marzec 2012, 01:09

Procedura w trochę dziwny sposób wymiaruje zaznaczoną figurę.
Jak przeczytasz informację, która się pojawia w chwili wyświetlenia komunikatu o błędzie, to będziesz wiedział dlaczego ten błąd powstaje. To polecenie powoduje zwymiarowanie obiektu i może być wywoływane z całym stadem parametrów z czego 4 muszą zostać podane. Rodzaj wymiaru, np. pionowy albo poziomy, współrzędne początkowego punktu i końcowego oraz to czy tekst wymiaru ma zostać wycentrowany. Jak tego nie ma, to jest błąd. Wyżej jest to samo polecenie.
Postaw apostrof przed tą linią i zobacz czy procedura robi to co chciałeś?

maroQ · Wysłany: 8 Marzec 2012, 19:24

michal.s · Wysłany: 9 Marzec 2012, 11:03

Po usunięciu wiersza "Set s = ActiveLayer.CreateLinearDimension" procedura wymiaruje bok w poziomie i przerywa operację komunikatem poniżej.

Macie rację wiersz jest zbędny.

test wymiarowanie X4 forum.cdr
plik X3 zapisany z makrem

Pobierz Plik ściągnięto 796 raz(y) 25.09 KB

maroQ · Wysłany: 9 Marzec 2012, 17:28

Cytat:

Macie rację wiersz jest zbędny.

Nie wiem czy mówisz że jest zbędny czy też mówisz to złośliwie :)

Na X3 wszystko działa. Ta linia na pewno jest zbędna. Jeśli nawet w planach miała ona czemuś służyć to zawiera niekompletny kod.
Metoda CreateLinearDimension zawiera parametry wymagane:
- Type typu: cdrlineardimensiontype
- Point1 typu: SnapPoint
- Point2 typu: SnapPoint
oraz szereg opcjonalnych parametrów. Podtrzymuję twierdzenie że linia jest zbędna.

Czytaj lepiej co sugeruje ten błąd. Co ciekawe również określenie TextX i TextY może nie być opcjonalne w innej wersji Corela niż X3 bo "u mnie działa" :D
Te parametry nie są opcjonalne, ale widać bez ich określenia też to może działać :) w X3. To jest normalka w VBA Corela, że coś niby wymaga zadeklarowania, ale jednak działa. Używając VB.NET nie da się popełnić takiego błędu.

Zobacz sobie taki myk:

Kod:

Sub MakeDimensions()
Dim x As Double, y As Double, sx As Double, sy As Double
Dim pt1 As SnapPoint, pt2 As SnapPoint
Dim s As Shape

ActiveSelection.GetBoundingBox x, y, sx, sy
Set pt1 = CreateSnapPoint(x, y)
Set pt2 = CreateSnapPoint(x + sx, y)
Set s = ActiveLayer.CreateLinearDimension(cdrDimensionHorizontal, pt1, pt2, True, 10, 10, cdrDimensionStyleDecimal, Units:=cdrDimensionUnitIN)

s.Dimension.TextShape.SetPosition x + sx / 2, y - 1
'Set s = ActiveLayer.CreateLinearDimension()
Set pt1 = CreateSnapPoint(x + sx, y)
Set pt2 = CreateSnapPoint(x + sx, y + sy)
Set s = ActiveLayer.CreateLinearDimension(cdrDimensionVertical, pt1, pt2, True, 10, 10, cdrDimensionStyleDecimal, Units:=cdrDimensionUnitIN)
s.Dimension.TextShape.SetPosition x + sx + 1, y + sx / 2
End Sub

Zmieniło się to, że dodałem 10 w miejscach pustych w metodzie CreateLinearDimension.

Może tak być, że w X4 coś nie działa. Przykładowo w X5 są problemy z eksportem z kompresją do Tif (z makra) i nic się z tym nie da zrobić bo to jest błąd Corela (zresztą zgłaszany do Corela bez rezultatu). VBA dla Corela w przeciwieństwie do VBA Office miewa "ciekawe stany umysłu".

michal.s · Wysłany: 9 Marzec 2012, 21:46

MaroQ, ani przez moment nie byłem złośliwy.
Wszystkie rady, które mi przekazujecie (mam na myśli Ciebie i Chezare), sumiennie wprowadzam w życie i już mam tego efekty. Makro do siatki opakowania przygotowałem w X5 i działa bez zarzutu. Jest tylko jeden mały problem. X5 mam trialową, a normalnie pracuję w X4 i w/w procedura do wymiarowania w niej nie działa. Spróbuję rozwiązania, które zaproponowałeś i dam Ci znać. Mam nadzieję, że zadziała :) Dziękuję Tobie bardzo za poświęcony mi czas i za POMOC :-)

michal.s · Wysłany: 9 Marzec 2012, 23:42

MaroQ, NIE DZIAŁA :-(

chezare · Wysłany: 10 Marzec 2012, 12:08

Ta ostatnia procedura zamieszczona przez MaroQ w X3 działa, nie wiem jak w X4 bo nie mam?
Komunikat, o którym wspomniałeś wyżej bierze się najprawdopodobniej stąd, że do wymiarowania Corel używa aktualnie ustawionego fontu i aktualnie ustawionego jego rozmiaru, który musi się mieścić w jakichś granicach, ewentualnie być może jest za duży żeby się zmieścił w miejscu, w które próbuje go wstawić procedura?
Co oznacza "NIE DZIAŁA"?

michal.s · Wysłany: 10 Marzec 2012, 13:10

Komunikat który wyskakuje w X4 wygląda jak poniżej.
Próbowałem już zmieniać ustawienia tekstu na mniejszy i większy, cały czas występuje błąd.
Zastanawia mnie jedno. W makrze podany jest parametr Units:=cdrDimensionUnitMM, w ustawieniach domyślnych są cm, a zwymiarowany element jest w in. Czyż nie jest to dziwne?
A może można wymusić przez makro wszystkie parametry wymiarowania?
Zaznaczony element zostaje zwymiarowany i później procedura zostaje wstrzymana komunikatem i nie zostaje wykonana pozostała część procedury.

Pisząc NIE DZIAŁA miałem na myśli myk który zaproponował MaroQ.

chezare · Wysłany: 10 Marzec 2012, 19:26

Michał, zajrzyj do pomocy na temat tego polecenia. Wygląda na to, że można ustawić praktycznie wszystko, od jednostek po kolory :-)

Jedyny problem jaki tu widzę i którego nie da się rozwiązać, to to, że polecenie nie ma rozumu i nie potrafi czytać naszych myśli i wymiarować to co akurat chcemy :-)

Chociaż zamiast całej figury można zaznaczyć dwa punkty, ale wtedy procedura nie będzie wiedziała czy poziomo, pionowo a może na ukos? :-)

Cały problem, od początku wydaje mi się bardziej zabawą typu da się to zrobić czy nie, niż poszukiwaniem praktycznych rozwiązań? Jedyna korzyść z tego taka, że czegoś się przy okazji nauczysz. Kilka prostokątów można narysować w parę chwili, a pomylić się przy ich wymiarowaniu tak samo łatwo wpisując wymiary w oknie programu jak w formularzu.

michal.s · Wysłany: 12 Marzec 2012, 23:10

Chezare, wymiękam.
Siedzę i siedzę i :evil:

.
Wypróbowałem już wszystkie kombinacje wprowadzając dane z pomocy, tak jak sugerowałeś.
Sam nie jestem w stanie nic zrobić.
Proszę Ciebie jako EXPERTA O POMOC w prawidłowym zapisaniu wiersza :-)

Kod:

Set s = ActiveLayer.CreateLinearDimension(Type As cdrLinearDimensionType, Point1 As SnapPoint, Point2 As SnapPoint, [TextCentered As Boolean = True], [TextX As Double], [TextY As Double], [Style As cdrDimensionStyle = cdrDimensionStyleDecimal], [Precision As Long = 2], [ShowUnits As Boolean = True], [Units As cdrDimensionLinearUnits = cdrDimensionUnitMM], [Placement As cdrDimensionPlacement = cdrDimensionWithinLine], [HorizontalText As Boolean = False], [BoxedText As Boolean = False], [LeadingZero As Boolean = True], [Prefix As String], [Suffix As String], [OutlineWidth As Double = -1], [Arrows As ArrowHead], [OutlineColor As Color], [TextFont As String], [TextSize As Double], [TextColor As Color]) As Shape

chezare · Wysłany: 13 Marzec 2012, 07:14

Długi wiersz :-)

Jeśli to jest rzeczywiście jeden wiersz to ok, ale jak po drodze wciskałeś enter, to takie coś nie zadziała bo interpreter nie traktuje tego jako całości, nie wnikam w tej chwili w poprawność tego zapisu. Jak masz długi kod i w następnym wierszu jest dalsza część kodu, to na końcu stawia się znak _, który informuje interpreter, że w kolejnym wierszu jest dalszy ciąg polecenia.
Jak ja bym powiedział, że jestem ekspertem od VBA, to Szaman by mnie zabił i całkiem słusznie zresztą :-)

. Ja na VBA się dosyć mizernie znam, ale miałem do czynienia z paroma innymi językami programowania, stąd może mi czasami łatwiej?
Na razie mam problem z czasem, ale jak problem się do wieczora nie rozwiąże, to się temu przyjrzę i mam nadzieję, znajdę rozwiązanie :-)