|
Corel FORUM
Forum użytkowników programów firmy Corel. Grafika wektorowa, rastrowa i obróbka zdjęć cyfrowych
|
Wyszukaj obiekty z określonym kolorem konturu i usuń je |
Autor |
Wiadomość |
Franiu
Bywalec
Wersja CorelDRAW: X5
Dołączył: 13 Sie 2015 Posty: 20 Skąd: Łódź
|
Wysłany: 13 Sierpień 2015, 11:48 Wyszukaj obiekty z określonym kolorem konturu i usuń je
|
|
|
Witam;
Mam taki trywialny problem (tak mi się przynajmniej wydaje), ale niestety przeszukując fora niestety nie znalazłem odpowiedzi, a sam z VBA jestem za duża noga, aby sobie z tym poradzić.
Potrzebuje makra pod X5, które będzie wyszukiwało wszystkie obiekty mające określony kolor konturu w cmyk, rozgrupowywało je (większość z nich znajduje się bowiem w jakiś grupach), a następnie je kasowało.
PS
Przez lata używaliśmy w firmie CDR 9 i polecenia ZNAJDŹ I ZAMIEŃ z zapisanymi ustawieniami, które dawało się ustawić w menu programu jako osobne ikony i działało to pięknie. Niestety potem przerzuciliśmy się na X4, a teraz na X5 i tam niestety nie da się zapisanych poleceń ZNAJDŹ I ZAMIEŃ wyciągnąć na pasek menu. Trzeba od cholery się naklikać, aby takie polecenie uruchomić stąd też pomysł na makro które bez problemu da się wyciągnąć na pasek menu.
Z góry dzięki za pomoc.
Franiu |
|
|
|
|
Shame
Red Dot Corporation
Wersja CorelDRAW: X7
Pomógł: 213 razy Wiek: 40 Dołączył: 19 Kwi 2012 Posty: 2565 Skąd: Poznań
|
Wysłany: 13 Sierpień 2015, 20:03
|
|
|
Franiu napisał/a: | Trzeba od cholery się naklikać, aby takie polecenie uruchomić |
Z tego co wiem, można parametry szukania zapisać do późniejszego wgrania ich w wyszukiwarkę. Raz ustawisz, zapiszesz i wtedy odpalenie takiego szukania o określonych parametrach to 3 kliknięcia.
Niestety, nie da się wyciągnąć tej opcji zparametryzowanej (żeby ładowała określone, zapisane parametry wyszukiwania) |
|
|
|
|
Franiu
Bywalec
Wersja CorelDRAW: X5
Dołączył: 13 Sie 2015 Posty: 20 Skąd: Łódź
|
Wysłany: 13 Sierpień 2015, 21:54
|
|
|
Shame napisał/a: | to 3 kliknięcia |
No właśnie nie do końca 3. CTRL+F -> Załaduj ustawienia wyszukiwania z dysku -> Wskazanie pliku (parę ich mamy więc trzeba chwilkę poszukać) -> Zakończ -> Znajdź wszyskie -> Czy chesz rozdzilić grupy? (Tak) -> Zamknięcie okna - > Delete
Niby nie dużo, ale jak się to robi kilkadziesiąt razy dziennie to można lekko się zirytować. Dlatego pomysł, aby załatwić to jednym kliknięciem makra... |
|
|
|
|
chezare
Pomógł: 402 razy Dołączył: 24 Gru 2010 Posty: 4551 Skąd: Grodzisk Mazowiecki
|
Wysłany: 14 Sierpień 2015, 22:05
|
|
|
Żeby skasować obiekt w grupie wcale nie trzeba tej grupy rozdzielać, to raz.
Dwa, gdzieś na forum jest makro które chyba włączało nadrukowanie dla czarnego, tam jest fragment który szuka koloru, można go zmodyfikować.
Przy okazji, może ktoś nie wie żeby zaznaczyć obiekt zgrupowany z innymi wystarczy wcisnąć ctrl. |
|
|
|
|
tomek123
Bywalec tomek123
Wersja CorelDRAW: X7
Pomógł: 8 razy Dołączył: 06 Gru 2014 Posty: 34 Skąd: Tychy
|
Wysłany: 2 Październik 2015, 19:21
|
|
|
Kod: |
Public Sub Del_CMYK_outline()
Dim s_all As ShapeRange, s_target As ShapeRange, quest As String, i As Integer
v_col = Array("Cyan", "Magenta", "Yellow", "Kadm")
v_param = Array(0, 0, 0, 0)
For i = LBound(v_col) To UBound(v_col)
Do
v_param(i) = InputBox("Podaj wartość koloru " & v_col(i) & " [0-100]:", v_col(i), v_param(i))
Loop While v_param(i) < 0 And v_param(i) > 100
Next i
Set s_all = ActiveDocument.ActivePage.ActiveLayer.Shapes.all
quest = "@outline.color = cmyk(" & v_param(0) & "," & v_param(1) & "," & v_param(2) & "," & v_param(3) & ")"
Set s_target = s_all.Shapes.FindShapes(query:=quest)
s_target.Delete
End Sub
|
|
|
|
|
|
Franiu
Bywalec
Wersja CorelDRAW: X5
Dołączył: 13 Sie 2015 Posty: 20 Skąd: Łódź
|
Wysłany: 2 Październik 2015, 23:51
|
|
|
Dzięki serdecznie, ale niestety po uruchomieniu (wklejeniu kodu do Global Macros-Modules-CorelMacros) makro się wykrzacza na 3 linii i dostaje komunikat: compile error: VAriable not definied |
|
|
|
|
tomek123
Bywalec tomek123
Wersja CorelDRAW: X7
Pomógł: 8 razy Dołączył: 06 Gru 2014 Posty: 34 Skąd: Tychy
|
Wysłany: 4 Październik 2015, 12:19
|
|
|
Masz włączoną opcję Option Explicit -> wpis na samej górze modułu, to dobre ale czasami denerwujące. Albo ją wyłącz w opcjach albo zadeklaruj zmienne jak poniżej:
Kod: |
Public Sub Del_CMYK_outline()
Dim s_all As ShapeRange, s_target As ShapeRange, quest As String, i As Integer, v_col As Variant, v_param As Variant
v_col = Array("Cyan", "Magenta", "Yellow", "Kadm")
v_param = Array(0, 0, 0, 0)
For i = LBound(v_col) To UBound(v_col)
Do
v_param(i) = InputBox("Podaj wartość koloru " & v_col(i) & " [0-100]:", v_col(i), v_param(i))
Loop While v_param(i) < 0 And v_param(i) > 100
Next i
Set s_all = ActiveDocument.ActivePage.ActiveLayer.Shapes.all
quest = "@outline.color = cmyk(" & v_param(0) & "," & v_param(1) & "," & v_param(2) & "," & v_param(3) & ")"
Set s_target = s_all.Shapes.FindShapes(query:=quest)
s_target.Delete
End Sub
|
|
|
|
|
|
Franiu
Bywalec
Wersja CorelDRAW: X5
Dołączył: 13 Sie 2015 Posty: 20 Skąd: Łódź
|
Wysłany: 5 Październik 2015, 10:46
|
|
|
Ooo teraz super działa. Nie potrzebuje tylko okienka z pytaniem o konkretny kolor bo wartość tą na sztywno podaje już w samym makro. Zmieniłem sobie to na poniższy sposób, pewnie mało elegancko ale działa. :)
Kod: |
Public Sub Del_CMYK_outline1()
Dim s_all As ShapeRange, s_target As ShapeRange, quest As String, i As Integer, v_col As Variant, v_param As Variant
v_col = Array("Cyan", "Magenta", "Yellow", "Kadm")
v_param = Array(0, 0, 0, 0)
For i = LBound(v_col) To UBound(v_col)
Do
' v_param(i) = InputBox("Podaj wartość koloru " & v_col(i) & " [0-100]:", v_col(i), v_param(i))
Loop While v_param(i) < 0 And v_param(i) > 100
Next i
Set s_all = ActiveDocument.ActivePage.ActiveLayer.Shapes.All
quest = "@outline.color = cmyk(0,0,0,100)"
Set s_target = s_all.Shapes.FindShapes(query:=quest)
s_target.Delete
End Sub |
Mam jeszcze jedną prośbę o inne makro, skoro z tym tak ładnie się udało. :) Z góry dzięki.
Myślę, że załatwi to ten sam kod tylko pojawią się ze dwie dodatkowe linijki. Chodzi o to, żeby wyszukiwało określony (na sztywno wpisany w makro) kolor konturu CMYK (czasem w grupach, czasem nie - czyli identyczne założenie jak w Del_CMYK_outline) i zamiast usuwać to zamieniać na inny kolor ten wyszukany kontur (inny konkretny CMYK, sztywno określony w makro). Na końcu powinny się wszystkie obiekty zaznaczać i odbijać lustrzanie w poziomie (robić lewoczytelny rysunek). |
|
|
|
|
tomek123
Bywalec tomek123
Wersja CorelDRAW: X7
Pomógł: 8 razy Dołączył: 06 Gru 2014 Posty: 34 Skąd: Tychy
|
Wysłany: 5 Październik 2015, 16:41
|
|
|
Kod: |
Public Sub CMYK_outline_change_flip()
Dim s As Shape, s_all As ShapeRange, s_target As ShapeRange, quest As String
Set s_all = ActiveDocument.ActivePage.ActiveLayer.Shapes.all
quest = "@outline.color = cmyk(0,50,50,0)" 'kolor konturu szukany
Set s_target = s_all.Shapes.FindShapes(query:=quest)
For Each s In s_target
s.Outline.Color.CMYKAssign 0, 0, 0, 100 'nowy kolor konturu
Next s
s_all.Flip 1 'odbicie lustrzane
End Sub
|
|
|
|
|
|
Franiu
Bywalec
Wersja CorelDRAW: X5
Dołączył: 13 Sie 2015 Posty: 20 Skąd: Łódź
|
Wysłany: 5 Październik 2015, 18:56
|
|
|
Super, działa!!! Dzięki jak nie wiem co. Jak mogę się odwdzięczyć, bo pół życia życia przy corelu właśnie mi oszczędziłeś. |
|
|
|
|
tomek123
Bywalec tomek123
Wersja CorelDRAW: X7
Pomógł: 8 razy Dołączył: 06 Gru 2014 Posty: 34 Skąd: Tychy
|
Wysłany: 6 Październik 2015, 02:28
|
|
|
Świetnie, cieszę się, jak będziesz miał jeszcze jakiś problem w Corelu z automatyzacją, to zapodaj, lubię czasami takie zadanka do rozruszania, dla przypomnienia VBA, bo ostatnio nie mam z tym do czynienia. pozdr |
|
|
|
|
Franiu
Bywalec
Wersja CorelDRAW: X5
Dołączył: 13 Sie 2015 Posty: 20 Skąd: Łódź
|
Wysłany: 16 Październik 2015, 16:50
|
|
|
A mam jeszcze jedną malutką prośbę. Znowu kompilacja tego co już było, ale z inną końcówką (myślałem, że poradzę sobie sam, ale niestety poległem).
Znajdujemy obiekty z określonym kolorem konturu w cmyku (tak jak wcześniej, kolor na sztywno wpisany w makro). Grupujemy je. Zaznaczamy tą grupę (tak jak kliknięcie myszą). |
|
|
|
|
tomek123
Bywalec tomek123
Wersja CorelDRAW: X7
Pomógł: 8 razy Dołączył: 06 Gru 2014 Posty: 34 Skąd: Tychy
|
Wysłany: 18 Październik 2015, 22:23
|
|
|
Kod: | Public Sub CMYK_outline_select()
Dim s_all As ShapeRange, s_target As ShapeRange, quest As String
Set s_all = ActiveDocument.ActivePage.ActiveLayer.Shapes.all
quest = "@outline.color = cmyk(0,50,50,0)" 'kolor konturu szukany
Set s_target = s_all.Shapes.FindShapes(query:=quest)
s_target.Group
s_target.CreateSelection
End Sub
|
|
|
|
|
|
Franiu
Bywalec
Wersja CorelDRAW: X5
Dołączył: 13 Sie 2015 Posty: 20 Skąd: Łódź
|
Wysłany: 21 Październik 2015, 00:02
|
|
|
Super! Dzięki ponownie jak nie wiem co! |
|
|
|
|
Franiu
Bywalec
Wersja CorelDRAW: X5
Dołączył: 13 Sie 2015 Posty: 20 Skąd: Łódź
|
Wysłany: 13 Listopad 2015, 19:09
|
|
|
Czym bardziej wgłębiam się w temat makr tym bardziej widzę ile ich jeszcze by się przydało do optymalizacji mojej pracy. Jeszcze takie rzeczy bardzo by mi się przydały (głupio mi znowu prosić o pomoc więc może podeślij nr konta na priva to uczynię jakiś datek, bo dzięki Twojej pomocy oszczędziłem już na prawdę dużo czasu - a jak wiadomo czas to pln )
MAKRO 1: ustawia domyślne pióro konturu dla opcji rysunek (czyli tak jak klikniemy na narzędzie PIÓRO KONTURU nie mając zaznaczonego żadnego obiektu) o parametrach: szerokość 6 mm, zakończenia zaokrąglone, konkretny kolor w cmyk podany na sztywno w makro
MAKRO 2: powraca do normalnych wartości domyślnego pióra konturu (czyli to samo co wyżej tylko dla standardowych parametrów corela): szerokość 0,2 mm, kolor czarny cmyk 0,0,0,100, zakończenia bez zaokrągleń
MAKRO 3: zmiana właściwości zaznaczonego konturu na grubość w mm, którą podajesz w wyskakującym okienku Msg (domyślnie powinna być podana wartość 3 mm), zmiana koloru na cmyk na sztywno podany w makro, opcja przezroczystości tego konturu: standardowa, normalna 50%
MAKRO 4: zmiana nazwy zaznaczonych przez użytkownika obiektów na nazwę: ObiektXYZ
To ostatnie makro udało mi się nawet nagrać i działa, ale niestety jeżeli zapomnę zaznaczyć chociaż jeden obiekt to wywala mi całego corela (dosyć niebezpieczne jeżeli się wcześniej nie zapisze pliku :) )
Kod: |
Sub Zamiana_nazwy_ObiektXYZ()
Dim OrigSelection As ShapeRange
Set OrigSelection = ActiveSelectionRange
ActiveSelection.ObjectData("Nazwa").Value = "ObiektXYZ"
End Sub |
|
|
|
|
|
chezare
Pomógł: 402 razy Dołączył: 24 Gru 2010 Posty: 4551 Skąd: Grodzisk Mazowiecki
|
Wysłany: 14 Listopad 2015, 01:52
|
|
|
Niebezpieczne może być nawet jak zapiszesz plik.
Można sprawdzić czy jakiś obiekt jest zaznaczony, można sprawdzić ile ich jest zaznaczonych.
Kod: | If ActiveSelectionRange.Count = 0 then goto koniec
. . . . .
koniec:
End Sub |
Można też obsłużyć ewentualne błędy, jedna z takich konstrukcji, jest ich wiele, poczytaj w pomocy, wygląda praktycznie identycznie jak polecenie wyżej omijające część kodu.
Kod: | On Error goto koniec
One Error Resume Next
|
itd., itp.
Oczywiście coś takiego powinno być przed poleceniami, które mogą wykoleić procedurę.
Z konturem to sprawa wygląda na dosyć prostą, tylko ja bym nie podczepiał tego pod oryginalne narzędzie.
Jak się nikt nie odezwie to jutro może coś wymyślę, albo może sam pokombinuj?
Kod: | ActiveSelection.Outline.SetProperties 0.236, OutlineStyles(0), CreateCMYKColor(0, 100, 100, 0)
|
Coś takiego np. ustawia grubość konturu, rodzaj na linię ciągłą i kolor (w tym przypadku czerwony). |
|
|
|
|
chezare
Pomógł: 402 razy Dołączył: 24 Gru 2010 Posty: 4551 Skąd: Grodzisk Mazowiecki
|
Wysłany: 14 Listopad 2015, 17:24
|
|
|
Na razie nie mam pojęcia jak zmienić domyślne ustawienia dla nieistniejących jeszcze obiektów, na pewno się da to zrobić, ale wykombinowałem sposób, jak ten brak wiedzy obejść.
To jest wykorzystanie mechanizmu, który w Corelu znajduje się w Opcje->Dokument.
Jeśli otworzysz nowy dokument i np. klikniesz narzędzie Text Tool, zmienisz font, jego wielkość to otworzy Ci się okienko w którym zostaniesz zapytany czy ustawienia mają zostać zastosowane dla tekstu akapitowego czy artystycznego. Od tej pory narzędzie Text Tool będzie działało z wprowadzonymi wcześniej ustawieniami.
Podobnie jest w innych przypadkach. Jeśli bez zaznaczania jakiegokolwiek obiektu klikniesz prawym przyciskiem gryzonia w jakiś kolor, to program znowu zapyta czy taki kolor konturu ma być stosowany dla grafiki czy tekstu akapitowego lub artystycznego. Jeśli wybrałeś np. Graphic, to wszystkie obiekty tego typu które będziesz od tej pory rysował będą miały kolor konturu który wcześniej wybrałeś. W taki sposób możesz też oczywiście zmienić domyślne parametry konturu, jego grubość, kolor i zakończenia.
Jeśli po tej operacji zaznaczysz opcję, którą ja zaznaczyłem na obrazku wyżej i zapiszesz dokument to każdy nowy, nawet po zamknięciu Corela będzie korzystał z tych ustawionych wartości. To co wykombinowałem działa podobnie, ale nie zmienia ustawień na stałe.
Istnieje polecenie które nazywa się SaveStyleSheet, zapisuje ono ustawienia do pliku.
Jeśli ustawisz sobie właściwości konturu
przejdziesz do edytora VBA (alt+F11) i uruchomisz makro
Kod: | Sub zapisz_kontur()
Application.ActiveDocument.SaveStyleSheet ("c:\kontur_6mm_zielony")
End Sub |
to na dysku C: zapisze Ci się plik kontur_6mm_zielony
Teraz musisz utworzyć makro, które będzie dostępne z dowolnego dokumentu i które powinno wyglądać tak
Kod: | Sub kontur_6mm_zielony()
On Error Resume Next
Application.ActiveDocument.LoadStyleSheet ("c:\kontur_6mm_zielony")
End Sub |
On error jest na wypadek gdyby pliku nie było.
Uruchomienie takiego makra spowoduje przeczytanie ustawień z wcześniej zapisanego pliku, każda linia, każda figura będzie miała teraz zielony 6 mm kontur i okrągłe zakończenia linii.
Drugi plik ze standardowymi ustawieniami pozwoli Ci zmienić zmodyfikowany kontur na taki jaki jest standardowo.
Odnośnie 3, to ja nie widzę za bardzo w tym co chcesz osiągnąć sensu, bo przecież jak masz zaznaczoną figurę, to wystarczy wpisać wartość w okienku dotyczącym grubości konturu, ale to jest akurat najłatwiejsze do zrealizowania.
MsbBox służy do wyświetlania informacji, pewnie miałeś na myśli InputBox? Nie wiem też o co chodzi z przeźroczystością, w moim zabytkowym Corelu kontur takiej właściwości nie ma.
Kod: | Sub ustaw_kontur()
Dim gr As Double
If ActiveSelectionRange.Count = 0 Then GoTo koniec
Application.ActiveDocument.Unit = cdrMillimeter
gr = InputBox("Wpisz grubość konturu", "KONTUR", "3")
ActiveSelection.Outline.SetProperties gr, OutlineStyles(0), CreateCMYKColor(0, 0, 0, 100)
koniec:
End Sub
|
Koledzy pewnie wymyślą coś bardziej sensownego, bo moja wiedza na temat Corelowego VBA, hierarchii obiektów, metod, właściwości, itp. ogranicza się do wciśnięcia klawisza F1. |
|
|
|
|
Franiu
Bywalec
Wersja CorelDRAW: X5
Dołączył: 13 Sie 2015 Posty: 20 Skąd: Łódź
|
Wysłany: 16 Listopad 2015, 12:01
|
|
|
Wow! Wszystko pięknie działa.
MAKRO 1 i 2: bardzo dobry pomysł z wczytywaniem tych ustawień. Utworzyłem sobie dwa pliki, podpiąłem pod makra i śmiga.
MAKRO 3: faktycznie przejęzyczyłem się z tym okienkiem Msg (chodziło oczywiście o Inputbox :) ). Makro niby proste, ale jak się wykonuje codziennie 500x to samo to zmniejszenie 5 kliknięć do 1 oszczędza godzinę. Jeśli chodzi o przezroczystość to faktycznie we wcześniejszych wersjach nie można było jej użyć do konturu (sprawdzałem w 9). W X5 bez problemu działa i bardzo mi tu jest potrzebne. Nagrałem sobie tą operację i po doklejeniu do Twojego makro wszytko śmiga, aż miło:
Kod: | Set OrigSelection = ActiveSelectionRange
With ActiveSelection.Transparency
.ApplyUniformTransparency 50
.AppliedTo = cdrApplyToFillAndOutline
.MergeMode = cdrMergeNormal
End With
|
MAKRO 4: dokleiłem podany warunek i nic się już nie wywala jak nie zaznaczę obiektu przed wykonaniem makra
Słowo się rzekło więc czas na podzielenie się zyskiem z oszczędzonego czasu. Podeślij na priva konto, to cosik sypnę. [/code] |
|
|
|
|
chezare
Pomógł: 402 razy Dołączył: 24 Gru 2010 Posty: 4551 Skąd: Grodzisk Mazowiecki
|
Wysłany: 16 Listopad 2015, 15:59
|
|
|
Franiu, jak chcesz komuś pomóc, to znajdziesz sposób i kogoś komu Twoja pomoc się przyda, ja, a jestem pewien, że znakomita większość kolegów również, nie zaglądamy tu żeby zarobić parę groszy. Przyznam się. Robię to z egoistycznych pobudek, sprawia mi przyjemność kiedy uda mi się komuś pomóc. Nie wiem, może to jakieś zboczenie? |
|
|
|
|
Franiu
Bywalec
Wersja CorelDRAW: X5
Dołączył: 13 Sie 2015 Posty: 20 Skąd: Łódź
|
Wysłany: 16 Listopad 2015, 16:09
|
|
|
Dziękuje więc serdecznie
Mało ludzi podobnie myślących zostało jeszcze na naszym łez padole, ale nieskromnie powiem że też jestem człowiekiem starej daty i staram się jak mogę nie ulec nowym trendom rynkowym. :) |
|
|
|
|
Franiu
Bywalec
Wersja CorelDRAW: X5
Dołączył: 13 Sie 2015 Posty: 20 Skąd: Łódź
|
Wysłany: 18 Listopad 2015, 16:08
|
|
|
Myślałem, że to już koniec, ale jednak nie. :) Jeszcze jedna potrzeba się zrodziła (apetyt rośnie w miarę jedzenia). :)
MAKRO 5: szuka obiektów posiadających określoną nazwę w menadżerze obiektów np: okiektXYZ i grupuje je
MAKRO 6: szuka obiektów posiadających określoną nazwę w menadżerze obiektów np: okiektXYZ i usuwa je |
|
|
|
|
chezare
Pomógł: 402 razy Dołączył: 24 Gru 2010 Posty: 4551 Skąd: Grodzisk Mazowiecki
|
Wysłany: 18 Listopad 2015, 23:59
|
|
|
Może tak?
Kod: | Sub SZUKAJ_NAZWY()
Dim s As Shape
Dim odp
Dim gr As ShapeRange
Dim naz As String
On Error Resume Next
Optimization = True
naz = InputBox("Wpisz nazwę", "SZUKAJ", "ObiektXYZ")
If naz = "" Then
MsgBox "Musisz coś wpisać…"
GoTo koniec
End If
Set gr = ActivePage.Shapes.All.UngroupAllEx
ActiveDocument.ClearSelection
For Each s In ActivePage.Shapes
If s.ObjectData("Nazwa").Value = naz Then
s.AddToSelection
End If
Next s
If ActiveSelection.Shapes.Count <> 0 Then
ActiveSelection.Group
odp = MsgBox("Usunąć zaznaczone?", vbYesNo, "Objects")
If odp = vbYes Then ActiveSelection.Delete
End If
koniec:
Optimization = False
ActiveWindow.Refresh
End Sub |
To działa tak, że najpierw się pyta o szukaną nazwę, domyślnie taką jak wcześniej chciałeś,
później rozdziela wszystkie grupy, jeśli jakieś oczywiście są i robi tak, żeby nic nie było zaznaczone.
To po to, żeby w kolekcji zaznaczonych obiektów nie znalazł się taki, który był zaznaczony przed
uruchomieniem procedury.
Na końcu jeśli coś zostało znalezione, to pyta się czy skasować. Odpowiedź negatywna
kończy procedurę pozostawiając zaznaczone i zgrupowane, znalezione obiekty które spełniają
warunek (konkretna nazwa we właściwościach).
Wcześniej coś Ci się wykolejało kiedy nic nie było zaznaczone, w tej procedurze jest taki fragment, który taką okoliczność bada:
If ActiveSelection.Shapes.Count <> 0 Then
Jak byś miał coś takiego:
…
if activeselection.shapes.count=0 then goto koniec
…
…
koniec:
end sub
to i bez obsługi błędów by Ci się nie wykolejało.
Franek, tylko zrób jakieś próby zanim stanie się nieszczęście, bo ja to piszę wciskając dwadzieścia razy na minutę klawisz F1 i żadnej gwarancji że coś nie wybuchnie nie daję.
Myślę, że jak już masz parę tych wynalazków których używasz, to można by je zebrać do kupy zrobić jakiś formularz i wybierać z listy, albo klikając w jakiś konkretny przycisk?
Tak to Ci się za chwilę zrobi śmietnik.
Zrobiłem taki przykładowy plik, musisz go wypakować do katalogu gdzie jest zainstalowany Corel …\DRAW\GMS. Po uruchomieniu Corela na liście z makrami będziesz miał to które jest wyżej, ale uruchamiane z formularza.
franek1.zip
|
Pobierz Plik ściągnięto 268 raz(y) 36.63 KB |
|
|
|
|
|
Franiu
Bywalec
Wersja CorelDRAW: X5
Dołączył: 13 Sie 2015 Posty: 20 Skąd: Łódź
|
Wysłany: 20 Listopad 2015, 13:04
|
|
|
Bardzo fajne to co napisałeś, ale do mojego użytku ciut za bardzo skomplikowane. Wolałbym jednak każde makro osobno. :)
Makra podpinam sobie pod ikony, które sam rysuje i mam do nich wtedy szybki dostęp (nie muszę wywoływać osobnego formularza, który też chwilkę zajmuje nie mówić o miejscu na ekranie).
Myślałem, że sam przerobie Twój kod niestety poległem (to o co prosiłem miało być częścią większej procedury, teraz opisuje całość od A-Z).
MAKRO 5 (cała procedura): szuka obiektów posiadających określoną nazwę ObiektXYZ (nazwa na sztywno w kodzie makro, a nie podawaną w inboxie), grupuje je (chyba to grupowanie nie jest potrzebne - wydawało mi się wcześniej, że następnego kroku nie da się wykonać bez tego, a jednak jak przed chwilą próbowałem to i bez grupowania też działa), zamienia kontury znalezionych obiektów w kontury (polecenie PRZEKSZTAŁĆ KONTUR W OBIEKT -CTRL+PRZESUNIĘCIE+Q), zmienia wypełnienia znalezionych obiektów na przezroczyste, zmienia kontury znalezionych obiektów na CMYK 1,0,0,100 , zmienia grubość znalezionych obiektów na 0,71 mm
MAKRO 6: szuka obiektów posiadających określoną na sztywno w kodzie makro nazwę ObiektXYZ i usuwa je |
|
|
|
|
chezare
Pomógł: 402 razy Dołączył: 24 Gru 2010 Posty: 4551 Skąd: Grodzisk Mazowiecki
|
Wysłany: 20 Listopad 2015, 15:38
|
|
|
To teraz ja mam kilka pytań.
Przyjmijmy, że w dokumencie jest ileś obiektów, które we właściwościach mają pole Nazwa i przypisaną do niego wartość ObiektXYZ.
Co robi zamiana konturu w obiekt? Ano rysuje nową figurę, jak mamy dajmy na to odcinek, to po wykonaniu tego polecenia otrzymujemy prostokąt. To samo można uzyskać rozłączając jakiś węzeł w zamkniętej figurze i dodając do niej obrys.
Wydaje mi się, że pomyliła Ci się kolejność wykonywanych działań.
Jeśli dobrze kombinuję, to powinno być tak:
1. Szukamy obiektu który w nazwie ma ObiektXYZ
2. W znalezionej figurze ustawiamy kontur na 0,71 mm
3. Zamieniamy kontur na obiekt
4. Zmieniamy kolor wypełnienia na 1/0/0/100, po zamianie w obiekt, nowa figura nie ma konturu.
?
Jeśli chodzi o kasowanie, to procedura niżej powinna załatwić sprawę.
Kod: | Sub Kasuj_ObiektXYZ()
Dim s As Shape
Dim gr As ShapeRange
On Error Resume Next
Optimization = True
Set gr = ActivePage.Shapes.All.UngroupAllEx
ActiveDocument.ClearSelection
For Each s In ActivePage.Shapes
If s.ObjectData("Nazwa").Value = "ObiektXYZ" Then s.Delete
Next s
Optimization = False
ActiveWindow.Refresh
End Sub |
Jeśli chodzi o pierwsze zadanie i ma być tak jak wykombinowałem, to będzie tak jak niżej.
Procedura kasuje figury, których kontur został zamieniony w obiekt (te które mają w Nazwa, ObiektXYZ), po wykonaniu procedury na stronie nie będzie już figur które mają w nazwa ObiektXYZ. Jeśli mają zostać, to trzeba wywalić kasowanie (s.delete).
Kod: | Sub kontur_w_obiekt()
Dim s As Shape
Dim gr As ShapeRange
On Error Resume Next
Optimization = True
Set gr = ActivePage.Shapes.All.UngroupAllEx
ActiveDocument.ClearSelection
For Each s In ActivePage.Shapes
If s.ObjectData("Nazwa").Value = "ObiektXYZ" Then
s.Outline.SetProperties 0.027983, OutlineStyles(0)
s.Outline.ConvertToObject
s.Fill.ApplyUniformFill Color:=CreateCMYKColor(1, 0, 0, 100)
s.Delete
End If
Next s
Optimization = False
ActiveWindow.Refresh
End Sub |
PS
Nie zapominaj, że to nie jest programowanie wysokich lotów.
Zakładaj hełm i rób kopie dokumentów. |
|
|
|
|
Franiu
Bywalec
Wersja CorelDRAW: X5
Dołączył: 13 Sie 2015 Posty: 20 Skąd: Łódź
|
Wysłany: 23 Listopad 2015, 12:46
|
|
|
A więc tak...
MAKRO 6 (kasujące): super ok, dziękuje :)
MAKRO 5 (szukające, przekształcające): no nie do końca jak Ty piszesz... :)
Generalnie wszystkie obiekty posiadające nazwę ObiektXYZ są specyficzne. Są to zawsze otwarte krzywe (nie żadne kwadraty, kółka lub inne figury) posiadające dużą grubość ok. 10-20 mm i określony kolor tego konturu, To co ma robić makro to znajdować je i robić je przezroczyste z czarną obwódką dookoła.
Po to nam to jest, że te przekształcone makrem obiekty idą do druku na ploter gdzie zależy nam na oszczędności atramentu (zwykłe szablony produkcyjne) wiec nie chcemy drukować grubaśnych krech, a jedynie ich czarno-białe kontury.
A więc moja poniższa kolejność jest jak najbardziej oki.
Szuka obiektów posiadających określoną nazwę ObiektXYZ (nazwa na sztywno w kodzie makro, a nie podawaną w inboxie), grupuje je (chyba to grupowanie nie jest potrzebne - wydawało mi się wcześniej, że następnego kroku nie da się wykonać bez tego, a jednak jak przed chwilą próbowałem to i bez grupowania też działa), zamienia kontury znalezionych obiektów w kontury (polecenie PRZEKSZTAŁĆ KONTUR W OBIEKT -CTRL+PRZESUNIĘCIE+Q), zmienia wypełnienia znalezionych obiektów na przezroczyste, zmienia kontury znalezionych obiektów na CMYK 1,0,0,100 , zmienia grubość znalezionych obiektów na 0,71 mm |
|
|
|
|
|
Nie możesz pisać nowych tematów Nie możesz odpowiadać w tematach Nie możesz zmieniać swoich postów Nie możesz usuwać swoich postów Nie możesz głosować w ankietach Nie możesz załączać plików na tym forum Możesz ściągać załączniki na tym forum
|
Dodaj temat do Ulubionych Wersja do druku
|
|
|
|
|
|
Nowe zasady dotyczące cookies. Wykorzystujemy pliki cookies, aby nasz serwis lepiej spełniał Państwa oczekiwania. Można zablokować zapisywanie cookies, zmieniając ustawienia przeglądarki.
| Strona wygenerowana w 0.15 sekundy. Zapytań do SQL: 16 |
|
|