| |
Corel FORUM
Forum użytkowników programów firmy Corel. Grafika wektorowa, rastrowa i obróbka zdjęć cyfrowych |
 |
Makra - Usuwanie podwójnych węzłów
zyzio - 31 Marzec 2018, 00:01
Temat postu: 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
restauro - 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 - 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 - 23 Kwiecień 2019, 10:38
Macro eCut ma takie narzędzie.
maroQ - 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 - 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?
|
|