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
Usuwanie podwójnych węzłów
Autor Wiadomość
zyzio 
Praktyk


Dołączył: 06 Cze 2011
Posty: 90
Skąd: Podkarpacie
Wysłany: 31 Marzec 2018, 00:01   Usuwanie podwójnych węzłów

Witam.
Znacie może jakiś sprytny sposób na automatyczne usunięcie podwójnych, niepotrzebnych węzłów z zaznaczonego obiektu?
Chodzi mi o sytuację jak na zrzucie w załączeniu.
Na chwilę obecną naprawiam to tak, że rozłączam w tym miejscu krzywą następnie ręcznie wyodrębniam jeden lub kilka niepotrzebnych węzłów i zamykam krzywą ponownie, lecz przy większej ilości obiektów to jest masakra.
Będę niezmiernie wdzięczny za wszelkie sugestie.
Pracuję w X3

Dzięki

Screen.jpg
Pobierz Plik ściągnięto 407 raz(y) 31.12 KB

 
 
restauro 



Wersja CorelDRAW: CorelDraw X4 ,X7
Pomógł: 573 razy
Dołączył: 25 Lis 2009
Posty: 7667
Skąd: Gdynia
Wysłany: 31 Marzec 2018, 14:32   

Jeśli masz na myśli skrót klawiaturowy to nie ,ale można to zautomatyzować ,trzeba tylko trochę nabrać wprawy .

Pomoc programu CorelDRAW -
Dodawanie, usuwanie, łączenie i wyrównywanie węzłów
 
 
zyzio 
Praktyk


Dołączył: 06 Cze 2011
Posty: 90
Skąd: Podkarpacie
Wysłany: 1 Kwiecień 2018, 14:38   

Miałem na myśli może coś w rodzaju ulepszonej redukcji węzłów, jakieś makro bo ta domyślna raz działa a raz nie.
 
 
Sparkman
Początkujący


Wersja CorelDRAW: Corel X6
Dołączył: 17 Kwi 2019
Posty: 5
Skąd: Wrocław
Wysłany: 23 Kwiecień 2019, 10:38   

Macro eCut ma takie narzędzie.
 
 
maroQ 
Doradca


Pomógł: 16 razy
Wiek: 39
Dołączył: 08 Lut 2011
Posty: 117
Skąd: Kalisz
  Wysłany: 15 Lipiec 2019, 21:10   

zyzio napisał/a:
Znacie może jakiś sprytny sposób na automatyczne usunięcie podwójnych, niepotrzebnych węzłów z zaznaczonego obiektu?


Kod:
Enum bbCoZrobic 'zawsze na początku modelu vba
    TylkoZaznacz = 0
    Usuwaj = 1
End Enum


Sub RemoveCloseNode(ByVal distance As Single, ByVal unit As cdrUnit, ByVal zadanie As bbCoZrobic, Optional ByVal elipsa As Single = 1)
    Rem Deklaracja zmiennych:
    Dim sr As New ShapeRange 'grupa kształtów (worek)
    Dim s As Shape 'kształt
    Dim s1 As Shape 'kształt
    Dim c As Curve 'krzywa
    Dim nr As New NodeRange 'grupa węzłów (worek)
    Dim n As Node 'węzeł
    Dim n1 As Node 'węzeł
   
    'w jakich jednostkach pracujemy
    ActiveDocument.unit = unit
   
    'przypisz kształt do zmiennej s i sprawdź czy istnieje
    Set s = ActiveShape
    If s Is Nothing Then
        Call MsgBox("Niestety nic nie zaznaczono!", vbCritical, "Błąd bardzo krytyczny")
        Exit Sub
    End If
   
    'na wypadek złego kształtu
    If s.Type <> cdrCurveShape Then
        Call MsgBox("Niestety zaznaczony kształt nie jest krzywą!", vbCritical, "Błąd konkretnie krytyczny")
        Exit Sub
    End If
   
    'zdefiniuj krzywą
    Set c = s.Curve

    'wykonuj dla wszystkich węzłów w krzywej
    For Each n In c.Nodes
        'jeśli odległość między węzłami jest mniejsza niż 'distance'
        If distance > n.GetDistanceFrom(n.Next) Then
            Set n1 = n.Next
            nr.Add n1 'dodaj węzeł do grupy (worka)
           
            If zadanie = TylkoZaznacz Then
                Set s1 = ActiveLayer.CreateEllipse(n1.PositionX - elipsa, n1.PositionY - elipsa, n1.PositionX + elipsa, n1.PositionY + elipsa)
                With s1 'operowanie na obiekcie s1 specyficzne dla języka Visual Basic  niedostępne w innych językach np. C#
                    .Fill.ApplyUniformFill ActivePalette.Colors(16) 'ustaw kolor wypełnienia dla aktywnej palety dla CMYK jest to czerwony dla innych nie wiem
                    .Outline.Color = ActivePalette.Colors(16) 'ustaw kolor krawędzi dla aktywnej palety dla CMYK jest to czerwony dla innych nie wiem
                    .Name = "znacznik węzła nr " & n1.Index 'ustaw nazwę dla węzła
                End With
                sr.Add s1 'dodaj do grupy krztałtów
            End If
        End If
    Next n
   
    If zadanie = Usuwaj Then
        nr.Delete 'kasuj węzły
    Else
        With sr.Group 'grupuj worek kształtów
            .Name = "Grupa znaczników" 'ustaw nazwę grupie
        End With
    End If
   
End Sub


Sub testZaznaczenia()
    Call RemoveCloseNode(0.8, cdrMillimeter, TylkoZaznacz, 0.1)
End Sub

Sub testUsuwania()
    Call RemoveCloseNode(0.8, cdrMillimeter, Usuwaj)
End Sub



Procedura testZaznaczenia powoduje wygenerowanie elips w miejscach w których występują podejrzane węzły.

Procedura testUsuwania kasuje następny węzeł który jest zbyt blisko.

UWAGA!!!
Makro może zmienić kształt krzywej!

Pierwszym parametrem dla funkcji RemoveCloseNode jest odległość między węzłami, drugim są jednostki np. mm, trzeci określa jaka operacja zostanie wykonana, a czwarty opcjonalny określa wielkość rysowanych elips (tylko dla zaznaczania).

Enum tak samo jak Type musi być zadeklarowany na początku modelu (wklejamy na górze strony przed innymi makrami).
Makro powinno działać na X3, ale w tym momencie nie mogę tego sprawdzić w razie problemów poszukam instalki.
 
 
zyzio 
Praktyk


Dołączył: 06 Cze 2011
Posty: 90
Skąd: Podkarpacie
Wysłany: 22 Październik 2019, 12:29   

Dziękuję bardzo za zainteresowanie, właśnie testuję w x3 tylko nie wiem czy robię to dobrze, z którego Sub-a powinienem odpalać makro?
 
 
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.11 sekundy. Zapytań do SQL: 15