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

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

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.

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.

#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é.

Tady je to jako ukázkový demo.

http://uloz.to/xCkf3F2b/prusecik-elipsy-s-primkou-ods