Priesecnik usecky a elipsy – Visual Basic – Fórum – Programujte.com
 x   TIP: Přetáhni ikonu na hlavní panel pro připnutí webu
Reklama
Reklama

Priesecnik usecky a elipsy – Visual Basic – Fórum – Programujte.comPriesecnik usecky a elipsy – Visual Basic – Fórum – Programujte.com

 

Hledá se programátor! Plat 1 800 € + bonusy (firma Boxmol.com)
Milos
~ Anonymní uživatel
25 příspěvků
8. 5. 2014   #1
-
0
-

Ahojte, prosím vás o pomoc. Potrebujem v malom programe vykreslovať úsečku a elipsu zadaním ich parametrov a ak maju nejaký priesečník, tak vypísať súradnice priesečníku. Niečo som nakódil, ale nefunguje to dobre. 

Ďakujem

Public Class Form1
    Public a, aa, b, bb, h, k, x1, y1, x2, y2, m, xi1, yi1, xi2, yi2, c, cc, d As Single
    Public mypen As Pen
    Public farba As Char = "0"
    
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

    End Sub

    Private Sub Form1_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles MyBase.Paint

    End Sub

    Private Sub TextBox5_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox5.TextChanged
        x1 = TextBox5.Text
    End Sub

    Private Sub Label1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs)

    End Sub

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        
        If farba = "1" Then mypen = New Pen(Drawing.Color.Red, 5)
        If farba = "2" Then mypen = New Pen(Drawing.Color.Green, 5)
        If farba = "3" Then mypen = New Pen(Drawing.Color.Yellow, 5)
        If farba = "4" Then mypen = New Pen(Drawing.Color.Blue, 5)
        If farba = "5" Then mypen = New Pen(Drawing.Color.Black, 5)
        If farba = "0" Then mypen = New Pen(Drawing.Color.Black, 5)

        Dim myGraphics As Graphics = Me.CreateGraphics
        myGraphics.DrawEllipse(mypen, a, b, h, k)
        myGraphics.DrawLine(mypen, x1, y1, x2, y2)

        EllipseIntersectLine()
        MsgBox(xi1)
        MsgBox(yi1)
        MsgBox(xi2)
        MsgBox(yi2)


    End Sub

    Private Sub TextBox6_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox6.TextChanged
        y1 = TextBox6.Text
    End Sub

    Private Sub TextBox7_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox7.TextChanged
        x2 = TextBox7.Text
    End Sub

    Private Sub TextBox8_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox8.TextChanged
        y2 = TextBox8.Text
    End Sub

    Private Sub TextBox1_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox1.TextChanged
        a = TextBox1.Text
    End Sub

    Private Sub TextBox2_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox2.TextChanged
        b = TextBox2.Text
    End Sub

    Private Sub TextBox3_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox3.TextChanged
        h = TextBox3.Text
    End Sub

    Private Sub TextBox4_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox4.TextChanged
        k = TextBox4.Text
    End Sub

    Private Sub Label7_Click(ByVal sender As System.Object, ByVal e As System.EventArgs)

    End Sub

    Private Sub ComboBox1_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ComboBox1.SelectedIndexChanged
        If ComboBox1.Text = "Červená" Then farba = "1"
        If ComboBox1.Text = "Zelená" Then farba = "2"
        If ComboBox1.Text = "Žltá" Then farba = "3"
        If ComboBox1.Text = "Modrá" Then farba = "4"
        If ComboBox1.Text = "Čierna" Then farba = "5"
    End Sub

    Private Sub Label7_Click_1(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Label7.Click

    End Sub

    Private Sub EllipseIntersectLine()

        If (x1 <> x2) Then

            m = (y2 - y1) / (x2 - x1)
            c = y1 - m * x1

            aa = a * b + a * a * m * m
            bb = 2 * a * a * c * m - 2 * a * a * k * m - 2 * h * b * b
            cc = b * b * h * h + a * a * c * c - 2 * a * a * k * c + a * a * k * k - a * a * b * b

        Else

            aa = a * a
            bb = -2.0 * k * a * a
            cc = -a * a * b * b + b * b * (x1 - h) * (x1 - h)

        End If

        d = bb * bb - 4 * aa * cc

        If (d > 0) Then


            If (x1 <> x2) Then


                xi1 = (-bb + Math.Sqrt(d)) / (2 * aa)
                xi2 = (-bb - Math.Sqrt(d)) / (2 * aa)
                yi1 = y1 + m * (xi1 - x1)
                yi2 = y1 + m * (xi2 - x1)

            Else

                yi1 = (-bb + Math.Sqrt(d)) / (2 * aa)
                yi2 = (-bb - Math.Sqrt(d)) / (2 * aa)
                xi1 = x1
                xi2 = x1
            End If

        Else
            MsgBox("nenastal prienik")

        End If

    End Sub
    
    Private Sub TextBox9_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox9.TextChanged

    End Sub
End Class

Nahlásit jako SPAM
IP: 62.197.243.–
Reklama
Reklama
Lader
~ Anonymní uživatel
4 příspěvky
26. 7. 2014   #2
-
0
-

Udělal jsem funkční kód do maximy (pouze numerické řešení). Pokud bude zájem můžu jej sem poslat. Ten můj kód je výpočetně náročnější než ten tvůj, asi by jej chtělo více zoptimalizovat.

Nahlásit jako SPAM
IP: 89.102.201.–
Lader
~ Anonymní uživatel
4 příspěvky
26. 7. 2014   #3
-
0
-

Tak jsem to zjednodušil a převedl do basicu:

Function Prusecik(A,B,Xe,Ye,X1,Y1,X2,Y2)
	Dim D#,J#,U#,V#,X12#,Y12#, P(4,1) As Variant
    X12 = X1-X2
    Y12 = Y1-Y2
    D = (Ye^2+B^2)*X12^2+2*((X2-X1)*((Xe-X1)*Y2+(X2-Xe)*Y1)*Ye+((Xe-X1)*(Xe-X2)-A^2)*Y1*Y2) _
    		-(Xe-X2-A)*(Xe-X2+A)*Y1^2-((Xe-X1-A)*(Xe-X1+A))*Y2^2
    If D>=0 Then 
        D = sqr(D)            
        J = A^2*Y12^2+B^2*X12^2
        P(0,0) = (A^2*Y12*(X12*Ye-X1*Y2+X2*Y1)+B*X12*(A*D-B*Xe*X12))/J        
        P(1,0) = (B^2*X12*((X1-Xe)*Y2+(Xe-X2)*Y1)+A*Y12*(B*D-A*Ye*Y12))/J   
      	P(2,0) = (A^2*Y12*(X12*Ye-X1*Y2+X2*Y1)-B*X12*(B*Xe*X12+A*D))/J
       	P(3,0) = (B^2*X12*((X1-Xe)*Y2+(Xe-X2)*Y1)-A*Y12*(A*Ye*Y12+B*D))/J
    End If
    Prusecik = P
End Function

Tu omáčku si dodělej.

Nahlásit jako SPAM
IP: 89.102.201.–
Lader
~ Anonymní uživatel
4 příspěvky
26. 7. 2014   #4
-
0
-

#3 Lader
Jo a

A,B - jsou poloosy elipsy

Xe,Ye - je střed elipsy

X1,Y1 - je libovolný bod na přímce

X2,Y2 - je jiný libovolný bod na přímce

Body X1,Y1,X2,Y2 udávají všechny parametry přímky včetně směru

Funkce vrací pole 4 údajů, jsou to souřadnice dvou bodů, které udávají místo kde se protne přímka s elipsou. Pokud se neprotne, funkce vrací prázdný údaj. Pokud se protne pouze v jednom místě, budou oba body identické.

Nahlásit jako SPAM
IP: 89.102.201.–
Lader
~ Anonymní uživatel
4 příspěvky
26. 7. 2014   #5
-
0
-
Nahlásit jako SPAM
IP: 89.102.201.–
Zjistit počet nových příspěvků

Přidej příspěvek

Toto téma je starší jak čtvrt roku – přidej svůj příspěvek jen tehdy, máš-li k tématu opravdu co říct!

Ano, opravdu chci reagovat → zobrazí formulář pro přidání příspěvku

×Vložení zdrojáku

×Vložení obrázku

Vložit URL obrázku Vybrat obrázek na disku
Vlož URL adresu obrázku:
Klikni a vyber obrázek z počítače:

×Vložení videa

Aktuálně jsou podporována videa ze serverů YouTube, Vimeo a Dailymotion.
×
 
Podporujeme Gravatara.
Zadej URL adresu Avatara (40 x 40 px) nebo emailovou adresu pro použití Gravatara.
Email nikam neukládáme, po získání Gravatara je zahozen.
-
Pravidla pro psaní příspěvků, používej diakritiku. ENTER pro nový odstavec, SHIFT + ENTER pro nový řádek.
Sledovat nové příspěvky (pouze pro přihlášené)
Sleduj vlákno a v případě přidání nového příspěvku o tom budeš vědět mezi prvními.
Reaguješ na příspěvek:

Uživatelé prohlížející si toto vlákno

Uživatelé on-line: 0 registrovaných, 10 hostů

Podobná vlákna

Obsah elipsy — založil JakubN

Nakloněné elipsy — založil Laaca

Pascal - Výpočet elipsy — založil Embrace

Ořezání úsečky a antialiasing — založil Anonymní uživatel

VYkreslení úsečky a SDL — založil yaqwsx

Moderátoři diskuze

 

Hostujeme u Českého hostingu       ISSN 1801-1586       ⇡ Nahoru Webtea.cz logo © 20032016 Programujte.com
Zasadilo a pěstuje Webtea.cz, šéfredaktor Lukáš Churý