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
wyszukanie krzywej o określonej ilości węzłów i podścieżek
Autor Wiadomość
michal.s 
Praktyk


Wersja CorelDRAW: x4
Pomógł: 1 raz
Dołączył: 01 Lut 2012
Posty: 65
Skąd: Poznań
Wysłany: 15 Wrzesień 2014, 12:18   wyszukanie krzywej o określonej ilości węzłów i podścieżek

Witam Wszystkich.
Czy jest może opcja, żeby za pomocą makra wyszukać krzywą która ma 4 węzły i dwie podścieżki.
Chodzi mi o wyszukanie w pracy krzyżyków (4 węzły, 2 podścieżki) z pominięciem kwadratów (4 węzły, 1 podścieżka).
W Corelu jest opcja wyszykiwania np krzywej i można tam zadać parametr żeby wyszukać węzły (niestety tylko węzły) o dokładnej ilości, mniejszej i większej.
Na pewno można to przygotować... :-)
 
 
maroQ 
Doradca


Pomógł: 16 razy
Wiek: 39
Dołączył: 08 Lut 2011
Posty: 117
Skąd: Kalisz
Wysłany: 15 Wrzesień 2014, 15:02   

michal.s napisał/a:
4 węzły i dwie podścieżki

Jak dla mnie to 2 podścieżki po dwa węzły każda.

To będzie coś w tym stylu:
Kod:
Sub FindCross()
    Dim s As Shape
   
    For Each s In ActivePage.Shapes.FindShapes(Type:=cdrCurveShape)
        If s.Curve.SubPaths.Count = 2 Then
            If s.Curve.SubPaths(1).Nodes.Count = 2 And s.Curve.SubPaths(2).Nodes.Count = 2 Then
                ActiveWindow.ActiveView.SetViewPoint s.LeftX + (s.SizeWidth) / 2, s.BottomY + (s.SizeHeight) / 2, 200
                If MsgBox("Czy to ten?", vbYesNo, "Pytanie?") = vbYes Then
                    Exit Sub
                End If
            End If
        End If
    Next s
End Sub


Nie pamiętam jak się skalowało podgląd by obejmował całe okno, ale jakby to było bardzo potrzebne to poszukam w starym kodzie. Tak przy okazji zapytam: Po co Ci te krzyżyki? Czy pracujesz może na mapach geodezyjnych? Bo tam takowe krzyżyki się pojawiają regularnie. Tam krzyżyki posiadają podścieżki w postaci odcinków przecinających się pod kątem prostym i to też można by w tym przypadku sprawdzać.
 
 
michal.s 
Praktyk


Wersja CorelDRAW: x4
Pomógł: 1 raz
Dołączył: 01 Lut 2012
Posty: 65
Skąd: Poznań
Wysłany: 15 Wrzesień 2014, 17:27   

Fajnie to działa i znajduje problematyczne krzyżyki :-)
Gdyby jeszcze po wskazaniu odpowiedniego elementu (Czy to ten?) zaznaczyło wszystkie identyczne... to nie mógłbym napisać "nie lubię poniedziałku" ;-)

Nawiązując do skalowania to:
Cytat:
Nie pamiętam jak się skalowało podgląd by obejmował całe okno...

ActiveWindow.ActiveView.ToFitSelection

Cytat:
Po co Ci te krzyżyki?

Krzyżyki są automatycznie przydzielane do poszczególnych elementów na pracy.
Potrzebne one są do precyzyjnego zmontowania poszczególnych elementów na folii (w załaczeniu plik)
W takiej wersji (bez warstw) importuję eps-a do Corela i zależy mi na wyodrębnieniu na inną warstwę krzyży oraz oznaczeń przy nich umieszczonych.
 
 
maroQ 
Doradca


Pomógł: 16 razy
Wiek: 39
Dołączył: 08 Lut 2011
Posty: 117
Skąd: Kalisz
Wysłany: 17 Wrzesień 2014, 15:51   

michal.s napisał/a:
ActiveWindow.ActiveView.ToFitSelection

Mi chodziło o "ActiveWindow.ActiveView.ToFitShape" ale itak dzięki.

To będzie coś w tym rodzaju:
Kod:
Sub FindSimularCross()
    If ActiveSelectionRange.Count = 0 Then GoTo bang
   
    Dim s As Shape, sa As Shape
    Dim sr As New ShapeRange
    Set sa = ActiveShape
   
    If sa.Type <> cdrCurveShape Then GoTo bang
    If sa.Curve.SubPaths.Count <> 2 Then GoTo bang
   
    ActiveDocument.Unit = cdrMillimeter
       
    For Each s In ActivePage.Shapes.FindShapes(Type:=cdrCurveShape)
        If s.Curve.SubPaths.Count = 2 Then
            If s.Curve.SubPaths(1).Nodes.Count = 2 And s.Curve.SubPaths(2).Nodes.Count = 2 Then
                               
                If Math.Abs(s.Curve.SubPaths(2).Nodes.First.PositionX - s.Curve.SubPaths(1).Nodes.First.PositionX) = Math.Abs(sa.Curve.SubPaths(2).Nodes.First.PositionX - sa.Curve.SubPaths(1).Nodes.First.PositionX) _
                   And Math.Abs(s.Curve.SubPaths(2).Nodes.First.PositionY - s.Curve.SubPaths(1).Nodes.First.PositionY) = Math.Abs(sa.Curve.SubPaths(2).Nodes.First.PositionY - sa.Curve.SubPaths(1).Nodes.First.PositionY) _
                   Then

                    sr.Add s
                End If
               
            End If
        End If
    Next s
   
    ActiveSelectionRange.RemoveFromSelection
    ActiveWindow.ActiveView.ToFitShapeRange sr
    sr.CreateSelection
    MsgBox "Znaleziono: " & sr.Count & " krzyżyków", vbInformation, "OK"
    Exit Sub
bang:
    MsgBox "Nie zaznaczono właściwego kształtu!", vbExclamation, "Niet"
End Sub
 
 
michal.s 
Praktyk


Wersja CorelDRAW: x4
Pomógł: 1 raz
Dołączył: 01 Lut 2012
Posty: 65
Skąd: Poznań
Wysłany: 17 Wrzesień 2014, 23:28   

WIELKIE DZIĘKI :-)

a to w ramach podziękowania:-)
najlepiej obejrzeć kilka razy :-)
http://youtu.be/Jbi2S8BZPws
 
 
michal.s 
Praktyk


Wersja CorelDRAW: x4
Pomógł: 1 raz
Dołączył: 01 Lut 2012
Posty: 65
Skąd: Poznań
Wysłany: 27 Wrzesień 2014, 22:25   

Działałem z makrem które napisałeś maroQ ale chyba coś źle robię ponieważ po zaznaczeniu krzyżyka znajduje mi tylko zaznaczony krzyżyk, innym razem zaznacza mi tylko dwa krzyże. Nie wiem co zrobić żeby zaznaczyło wszystkie zaznaczone elementy.
Jak zastosować Twoje makro żeby zaznaczyć wszystkie krzywe o czterech węzłach i dwóch podścieżkach?
Jaki będzie kod do zaznaczenia krzywej o określonej ilości węzłów np. 15
 
 
maroQ 
Doradca


Pomógł: 16 razy
Wiek: 39
Dołączył: 08 Lut 2011
Posty: 117
Skąd: Kalisz
Wysłany: 6 Październik 2014, 16:38   

michal.s napisał/a:
znajduje mi tylko zaznaczony krzyżyk, innym razem zaznacza mi tylko dwa krzyże

Znajduje tylko identyczne krzyże.

michal.s napisał/a:
Jak zastosować Twoje makro żeby zaznaczyć wszystkie krzywe o czterech węzłach i dwóch podścieżkach?

Tu masz najprostszy możliwy kod:

Kod:
Sub Find4Nodes2SubPaths()
    Dim s As Shape
    Dim sr As New ShapeRange
   
    For Each s In ActivePage.Shapes.FindShapes(, cdrCurveShape)
        If s.Curve.Nodes.Count = 4 And s.Curve.Segments.Count = 2 Then
            sr.Add s
        End If
    Next s
   
    ActiveSelectionRange.RemoveFromSelection
    ActiveWindow.ActiveView.ToFitShapeRange sr
    sr.CreateSelection
    MsgBox "Znaleziono: " & sr.Count & " krzywych o 4 węzłach i 2 podścieżkach", vbInformation, "OK"
End Sub


Jak chcesz sprawdzać jeszcze długości segmentów to w poprzednio publikowanym makrze zamień cały warunek zawierający instrukcje Abs na:
Kod:
If Math.Round(s.Curve.Length) = Math.Round(sa.Curve.Length) Then
      sr.Add s
End If
 
 
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.13 sekundy. Zapytań do SQL: 13