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

FAQFAQ  SzukajSzukaj  UżytkownicyUżytkownicy  GrupyGrupy
RejestracjaRejestracja  ZalogujZaloguj  DownloadDownload

Poprzedni temat «» Następny temat
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, 12: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: 39
Dołączył: 19 Kwi 2012
Posty: 2565
Skąd: Poznań
Wysłany: 13 Sierpień 2015, 21: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, 22: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, 23: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, 20: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


:roll:
 
 
Franiu
Bywalec


Wersja CorelDRAW: X5
Dołączył: 13 Sie 2015
Posty: 20
Skąd: Łódź
Wysłany: 3 Październik 2015, 00: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 :cry:
 
 
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, 13: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, 11: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, 17: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, 19: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ś. :-P
 
 
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, 03: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, 17: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, 23: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, 01: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ę. :mrgreen: [/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 :poklon

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ć&#8230;"
    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 239 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. :mrgreen:

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
 
 
Wyświetl posty z ostatnich:   
Odpowiedz do tematu
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

Skocz do:  

Powered by phpBB modified by Przemo © 2003 phpBB Group
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.17 sekundy. Zapytań do SQL: 15