skæringspunkt for to linjer

can you explain what you mean by "skærings punkt" so we have something to work with?

thanks

du skal forstille dig at man tager en tom-graf og sætter punktummer i de angivende kordinatter og tegner en linie igennem den.
sådan kan vi gøre 2 ved linje 1 og linje 2.
Men disse to linjer kommer til at ramme hinanden på et tidspunkt og den første gang den rammer hinanden kaldes for skæringspunkt.
det kunne være at linie 1 og 2 ramte hinanden på graffen ved kordinat [5,6] eller- ...

kan du følge mig

maybe its your example data which doesnt make sence!
should this not be line 2?

mine kordinater eks. for linje 1 er :
[50.0]
[0.50}

and why 50.0? are we going backwards?

sorry det er linie 2 .

på y skal der tegnes en prik : [0.50]
på x skal der tegnes en prik : [0.50]
og det bliver en streg som kommer oppefra y til x 0.50

Ok, I think I understand now!

It should be possible to have your data in one or more tables and then with code loop through the records to find the intersection.

Dont have time to make the code right now but I can maybe find a bit of time this evening to put something together.

hvis du kan det, så vil jeg takke dig mange mange mange gange :): ): )

Hm - lavede sådan noget i mid 80erne i basic, men hvor er det.

Du tager pkt sæt for pkt sæt og tester om de skærer
[0.5]- [1.7]
[50.0]- [0.50]

Når de skærer, så exit. Har du formlen for to liniers skæring, så er det bare igang.
Det var vist noget min datter rodede med i gymnasiet. Har du ikke selv en panserformel ?
Henrik

is it possible for you to send me some data and a diagram using this data?
eksperten@NOSPAMsanthell.dk
remove NOSPAM

wish i could , but it is not possibel for me to send them .....sory...

its years since I went to school and I dont recall doing anything like this. So I have to ask, is [0.5] = [X.Y] coordinates?

ja det er rigtigt

jeg har nogle kordinatter her som du kan bruge :
det er så
x        Y
0,09    0,00
0,17    0,00
0,34    0,01
0,43    0,01
0,60    0,01
0,69    0,02
0,78    0,02
0,95    0,02
1,03    0,03
1,21    0,03
1,29    0,03
1,47    0,03
1,55    0,04
1,72    0,04
1,81    0,04
1,98    0,04
2,07    0,05
2,24    0,05
2,33    0,05
2,50    0,05
2,59    0,06
2,76    0,06
2,84    0,06
3,02    0,06
3,10    0,07
3,28    0,07
3,36    0,07
3,45    0,07
3,62    0,08
3,71    0,08
3,88    0,08
3,97    0,08
4,14    0,09
4,22    0,09
4,40    0,09
4,48    0,09
4,57    0,09
4,74    0,10
4,83    0,10
5,00    0,10
5,09    0,10
5,26    0,11
5,34    0,11
5,52    0,11
5,60    0,11
5,78    0,11
5,86    0,12
6,03    0,12
6,12    0,12
6,29    0,12
6,38    0,13
6,55    0,13
6,64    0,13
6,81    0,13

tery det overstående er kordianter for linie 1

Kommentar: hnteknik
03/05-2005 15:27:53

jamen sagen er at vi har en masse kordinater for linie1
og noget for linie 2 også er det at vi skal finde ud af hvornår de skærere hinanden

Hvor mange data par har du for linie2 ??
2 sæt  eller flere ??

Det du skal lave er lidt materix regning for rullende sæt af (x1,y1) og (x2,y2) med den skærende linie (som formodes fast) (x3,y3) (x4,y4)

Her er en måde at beregne skæringspunktet på forskellige værdier:  http://www.geog.ucsb.edu/~kclarke/G128/Lecture12.html

phi-del>As I can see from the link hnteknik has given, I think I may have promissed something I cant give! I could "maybe" be able to give the two co-ordinates previous to the intersection, in other words, those from the table(s). But I dont think I'll be able to give you the exact co-ordinates of the calculated intersection, or at least not without a bit of math revision, which I dont intend doing just for this question :o)
So I better "Pass" on this one.

Sorry!

Kommentar: hnteknik
03/05-2005 17:32:36

for linie 2 er der kun 2 sæt start og slut som beskrivet foroven

hnteknik jeg ikke rigtige se hvilke af de formler jeg skal bruge, for jeg har en liste
af kordinatter for linie 2 som er på fra 100-600 måske

Man tager dem parvis fra f.eks. en array
mange af dem vil have en løsning men falde på at p er udenfor [X1;X2] området
og q er udenfor [Y1;Y2] området. Måske kan jeg lave en lille funktion henover kaffebordet, hvis overkommandoen tillader.

Jeg går ud fra x,y sættene ikke repræsenterer en lige line men kurve bestående af små liniestykker eller findes der formler for bedste kurve fit ved en x grad ligning som så itereres om på en anden kurve.

Dette er den formelle formel for beregning af et skæringspkt:

Option Compare Database
Sub test()
Dim x1, x2, x3, x4, y1, y2, y3, y4, p, q

x1 = 2: y1 = 2
x2 = 8: y2 = 8
x3 = 2: y3 = 9
x4 = 6: y4 = 3

    If lineintercept(x1, y1, x2, y2, x3, y3, x4, y4, p, q) Then
        MsgBox " Linierne skærer i [" & p & ";" & q & "]"
    Else
        MsgBox "Linierne er sammefaldne eller parallelle - ingen skæring"
    End If
End Sub

Function lineintercept(x1, y1, x2, y2, x3, y3, x4, y4, p, q)
Dim a1, b1, a2, b2
b1 = getb(x1, y1, x2, y2)
b2 = getb(x3, y3, x4, y4)
If b1 = b2 Then
   
    lineintercept = False
Else
    a1 = geta(x1, y1, b1)
    a2 = geta(x3, y3, b2)
    p = (a1 - a2) / (b2 - b1)
    q = a1 + b1 * p
    lineintercept = True
End If
End Function

Function getb(x1, y1, x2, y2)

If x1 = x2 Then
    MsgBox "linien er lodret - X=" & x1
    getb = 99999999
Else
    getb = (y2 - y1) / (x2 - x1)
End If
End Function
Function geta(x1, y1, b1)
    geta = y1 - b1 * x1
End Function

dertil skal der være en kontrol af at p ikke er udenfor [X1;X2] området
og q ikke er udenfor [Y1;Y2] området.

Som du kan se, er der problemer hvis en af linierne er lodrette altså X= x1 eller X= x3 så skal der lige regnes et specialtilfælde.

Her er den så med kontrol for om den er indenfor liniestykket - godnat:

Option Compare Database
Sub test()
Dim x1, x2, x3, x4, y1, y2, y3, y4, p, q, checkxy1

x1 = 2: y1 = 2
x2 = 4.7: y2 = 4.7
x3 = 2: y3 = 9
x4 = 6: y4 = 3
checkxy1 = True

    If lineintercept(x1, y1, x2, y2, x3, y3, x4, y4, p, q, checkxy1) Then
        MsgBox " Linierne skærer i [" & p & ";" & q & "]"
    Else
        MsgBox "Ingen skæring - Linierne er sammefaldne eller parallelle - eller skæring udenfor liniestykke"
    End If
End Sub

Function lineintercept(x1, y1, x2, y2, x3, y3, x4, y4, p, q, checkxy1)
Dim a1, b1, a2, b2
b1 = getb(x1, y1, x2, y2)
b2 = getb(x3, y3, x4, y4)
If b1 = b2 Then
   
    lineintercept = False
Else
    a1 = geta(x1, y1, b1)
    a2 = geta(x3, y3, b2)
    p = (a1 - a2) / (b2 - b1)
    q = a1 + b1 * p
   
    lineintercept = True
    If checkxy1 Then
        If (x2 > x1) Then
            If (p < x1) Or (p > x2) Then
                lineintercept = False
            End If
        Else
            If (p < x2) Or (p > x1) Then
                lineintercept = False
            End If
        End If
        If (y2 > y1) Then
            If (q < y1) Or (q > y2) Then
                lineintercept = False
            End If
        Else
            If (q < y2) Or (q > y1) Then
                lineintercept = False
            End If
        End If
    End If
End If
End Function

Function getb(x1, y1, x2, y2)

If x1 = x2 Then
    MsgBox "linien er lodret - X=" & x1
    getb = 99999999
Else
    getb = (y2 - y1) / (x2 - x1)
End If
End Function
Function geta(x1, y1, b1)
    geta = y1 - b1 * x1
End Function

Dette kan laves smukkere og enklere, men så vil du måske ikke helt forstå det:

    If checkxy1 Then
        If (x2 > x1) Then
            If (p < x1) Or (p > x2) Then
                lineintercept = False
            End If
        Else
            If (p < x2) Or (p > x1) Then
                lineintercept = False
            End If
        End If
        If (y2 > y1) Then
            If (q < y1) Or (q > y2) Then
                lineintercept = False
            End If
        Else
            If (q < y2) Or (q > y1) Then
                lineintercept = False
            End If
        End If
    End If

det her ser kanon ud :):)  tussind takker .
men der er lidt stor mundfuld og jeg prøver at forstå det hele, men jeg kan ikke se hvor du henter dataene fra databasen .

data for linie 2 er:
0,50
50,0    ' og det er en skråt streg der går fra x axen ned til y axen

data som ligger i min tabel er disse:  "det er for linie 1"
mm  n
0,09    0,00
0,17    0,00
0,34    0,01
0,43    0,01
0,60    0,01
0,69    0,02
0,78    0,02
0,95    0,02
1,03    0,03
1,21    0,03
1,29    0,03
1,47    0,03
1,55    0,04
1,72    0,04
1,81    0,04
1,98    0,04
2,07    0,05
2,24    0,05
2,33    0,05
2,50    0,05
2,59    0,06
2,76    0,06
2,84    0,06
3,02    0,06
3,10    0,07
3,28    0,07
3,36    0,07
3,45    0,07
3,62    0,08
3,71    0,08
3,88    0,08
3,97    0,08
4,14    0,09
4,22    0,09
4,40    0,09
4,48    0,09
4,57    0,09
4,74    0,10
4,83    0,10
5,00    0,10
5,09    0,10
5,26    0,11
5,34    0,11
5,52    0,11
5,60    0,11
5,78    0,11
5,86    0,12
6,03    0,12
6,12    0,12
6,29    0,12
6,38    0,13
6,55    0,13
6,64    0,13
6,81    0,13


også skal man bare have en mesgbox på hvilke kordinat de to skærehinanden på

data for linie 2 er:
0,50
50,0    ' og det er en skråt streg der går fra x axen ned til y axen

DATA FOR LINIE 2 er faste for hvergang .

Nå - jeg troede, at du havde fod på den del: prøv da denne

Sub test()
Dim x1, x2, x3, x4, y1, y2, y3, y4, p, q, checkxy1
checkxy1 = True
Dim Db As Database, rs As Recordset
Set Db = CurrentDb()
Set rs = Db.OpenRecordset("tblxy")

x3 = 0: y3 = 50
x4 = 50: y4 = 0

Do While Not rs.EOF
    x1 = x2: y1 = y2
    x2 = rs("x"): y2 = rs("y")
    If Not (x1 = Empty) Or Not (y1 = Empty) Then
        If lineintercept(x1, y1, x2, y2, x3, y3, x4, y4, p, q, checkxy1) Then
            MsgBox " Linierne skærer i [" & p & ";" & q & "]"
        'Else
            'MsgBox "Ingen skæring - Linierne er sammefaldne eller parallelle - eller skæring udenfor liniestykke"
        Exit Do
        End If
    End If
    rs.MoveNext
Loop
End Sub

???

Nå - jeg har brugt en del tid på det. Kunne i det mindste sige tak

hej Hnteknik, har pga. private årsager ikke kunne komme på netet intil nu, og det her er sådan gået istå..
jeg beklager og takker mange gange for hjælpen.

Det er ok

Hej hnteknik.

Jeg takker mange gange for din assistance.
Jeg er nu endlige kommet tilbage til det her, vil så meget gerne have det til at virke.
men det er en lille hage ved det her som jeg ikke kan løse derfor håber at du gider at give en lille med.
Jeg har prøvet at lave en database med graf og tal og smidt koden ind, men kunne få det til at virke :( :( pga at begge liniers kode er for en ret linie:

Function geta(x1, y1, b1)
    geta = y1 - b1 * x1
End Function

men det er desvære sådan at den ene linie ikke er ret og derfor melder den ikke noget rigtigt tilbage.

jeg har lavet en exempel, og håber at du vil kunne hælpe mig :), jeg er nemlige gået i stå igen :(

så kunne jeg nemlige åbne en ny spørgesmål, og sende databasen til dig så du kunne se nærmere på den

Kurven behøves ikke at være ret - det er jo kurvestykker, som der testes på.
Og en krum kurve del man jo blot op i de småstykker, man mener at have behov for,
delta Y = f( deltaX). Send gerne dit oplæg til hn*fjernstjernerogaltimellem*teknik@post4.tele.dk

Men der er jo jul, så der går nok et par dage førend at jeg får tid.

hej hnteknik og godt nytår.
Har du fået min mail ?

Ja jeg har fået din mail, men har ikke haft til tid til at nærlæse det igennem.

Hvis du har to tabeller hver med x,y for en række punkter på en knækket kurve skal jeg få programmet til at gennemløbe et sæt fra fra tabel1 xn,yn - xn+1, yn+1 mod et tilsvarende sæt i tabel2 for alle sæt i tabel1 og 2. Hvor der er skæring på delstumperne af de knækkede koder dumpes X,Y skæring til en tabel3.

Men jeg skal have 2 tabeller med mindst 2 sæt x,y i hver tabel, eller kan jeg ikke finde nogen som helst skæring.

Jeg intensivt læser til eksamen til på mandag, så jeg tvivler, at jeg får kigget på det før efter mandag. Men blot jeg har to tabeller med x,y sæt i. En 3. tabel med resultat er kun nødvendlgi hvis der er mere end et skæringspkt på de to knækkede kurver.

Godt nYtår til dig også Henrik

hej henrik. det er første gang de skære hinanden jeg skal bruge.

prøv denne her:

Private Sub skaeringspunkt()
Dim x1, x2, x3, x4, y1, y2, y3, y4, p, q, checkxy1, I As Integer, Popsy As String
checkxy1 = True
Dim rec As Recordset
Dim qry As QueryDef
Dim dbs As Database
Dim TempTable As String
Set dbs = CurrentDb

Numlock = "119167"
Nr = "1"
Mark = "0001"
Graf = "Graf1"

TempTable = "TmpGraf"
Set rec = dbs.OpenRecordset(TempTable)
       
'skæringspunkter
x3 = 0: y3 = 0.5
x4 = 50: y4 = 0
Popsy = ""
For I = 1 To 8
    rec.MoveFirst
    Do While Not rec.EOF
        x1 = x2: y1 = y2
        x2 = rec("Procent"): y2 = rec("Mpa" & I)
        If IsNull(x1) Or IsNull(y1) Or IsNull(x2) Or IsNull(y2) Then
            'do f.. nothing
        Else
            If lineintercept(x1, y1, x2, y2, x3, y3, x4, y4, p, q, checkxy1) Then
                Popsy = Popsy & " Linierne skærer i [" & p & ";" & q & "] for Mpa" & I & Chr(10) + Chr(13)
                Exit Do
            Else
                'MsgBox "Ingen skæring - Linierne er sammenfaldne eller parallelle - eller skæring udenfor liniestykke"
                '
            End If
      End If
   
      rec.MoveNext
    Loop
Next
    MsgBox "søgning gennemført" & Chr(10) + Chr(13) & Popsy
End Sub