Punkt auf 3D-Fläche (Autodesk/Rund um AutoCAD)

Hi
gebastelt: jau !!! - coole loesung waer ich so fix nicht drauf gekommen.

Wenn man mehr als ein paar dieser probleme hat.
google:
"vb6 area line intersection"
und
"vb6 point inside polygon".
Ich hab ein aehnlich gelagertes problem nur hab ich ca. 4000 von den flaechen. (ist bereits per vba geloest (inclusive speed problems))
Mit einer routine point in polygon ermitteln welche 3 punkte relavant sind
und dann eine routine drauf loslassen welche per vektorgeometrie den schnittpunkt einer geraden mit einer flaeche bestimmt.
Anbei die hauptroutinen als startpunkt.
Wie man aus ner 3dface polygonpunkte ermittelt steht in der vba hilfe

LG aus finnland

based on
http://alienryderflex.com/polygon/ - cool !

and a smallbasic (sourceforge !!!) demo/sample routine.

public type point3d
x as double
y as double
z as double

end type

' Globals which should be set before calling this function:

' The function provides the following return codes
' point is not in polygon : 0
' point is on polygonpoint : 1
' point is on polygon segment : 2
' point is inside polyon : 3

' Note that division by zero is avoided because the division is protected
' by the "if" clause which surrounds it.
Function POINT_IN_POLYGON_LINE_ALGORITHM(POLY() As POINT3D, P As POINT3D) As Long
POINT_IN_POLYGON_LINE_ALGORITHM = 0
Exit Function
'from http://alienryderflex.com/polygon/
Dim i As Integer
Dim j As Integer
Dim BOXMIN As POINT3D
Dim BOXMAX As POINT3D
Dim oddNodes As Boolean
oddNodes = False
POINT_IN_POLYGON_LINE_ALGORITHM = False
Dim Det As Double
j = UBound(POLY)
For i = 0 To UBound(POLY)
'are we directly on a polypoint ? (optional you could point point distace (Phytagoras) to make it more robust)
If P.x = POLY(i).x And P.y = POLY(i).y Then
POINT_IN_POLYGON_LINE_ALGORITHM = 1
Exit Function
End If
If POLY(i).x <> POLY(j).x Or POLY(i).y <> POLY(j).y Then 'avoid error by duplicated polypoints
'are we on a line segment ?
Det = (POLY(j).x - POLY(i).x) * (P.y - POLY(i).y) - (P.x - POLY(i).x) * (POLY(j).y - POLY(i).y)
If Abs(Det) <= EPSILON Then

If POLY(i).x < POLY(j).x Then
BOXMIN.x = POLY(i).x
BOXMAX.x = POLY(j).x
Else
BOXMIN.x = POLY(j).x
BOXMAX.x = POLY(i).x
End If

If POLY(i).y < POLY(j).y Then
BOXMIN.y = POLY(j).y
BOXMAX.y = POLY(i).y
Else
BOXMIN.y = POLY(j).y
BOXMAX.y = POLY(i).y
End If

If P.x >= BOXMIN.x And P.x <= BOXMAX.x And P.y >= BOXMIN.y And P.y <= BOXMAX.y Then
POINT_IN_POLYGON_LINE_ALGORITHM = 2
Exit Function
End If
End If
'are we inside ?
If ((POLY(i).y < P.y And POLY(j).y >= P.y Or POLY(j).y < P.y And POLY(i).y >= P.y) And (POLY(i).x <= P.x Or POLY(j).x <= P.x)) Then
If (POLY(i).x + (P.y - POLY(i).y) / (POLY(j).y - POLY(i).y) * (POLY(j).x - POLY(i).x) < P.x) Then oddNodes = Not (oddNodes)
End If
End If
j = i
Next
If oddNodes = True Then POINT_IN_POLYGON_LINE_ALGORITHM = 3
End Function

Sub intersect_line_plane(a As POINT3D, b As POINT3D, c As POINT3D, d As POINT3D, E As POINT3D, r As POINT3D)
'A-C = POINT on plane
'D-E = POINTs of line
'R = INTERSECTIONPOINT

' Debug.Print "START INTERSECTION"
Dim ED As POINT3D, BA As POINT3D, CA As POINT3D
Dim MA, MB, mc, md, DEN, u As Double
'INIT:
'GERADE

ED.x = E.x - d.x
ED.y = E.y - d.y
ED.z = E.z - d.z
'FLAECHE
BA.x = b.x - a.x
BA.y = b.y - a.y
BA.z = b.z - a.z

CA.x = c.x - a.x
CA.y = c.y - a.y
CA.z = c.z - a.z
'Inverse matritze)

MA = BA.y * CA.z - BA.z * CA.y
MB = BA.z * CA.x - BA.x * CA.z
mc = BA.x * CA.y - BA.y * CA.x
md = -(MA * a.x + MB * a.y + mc * a.z)
DEN = (MA * ED.x + MB * ED.y + mc * ED.z)
If DEN <> 0 Then
u = -(MA * d.x + MB * d.y + mc * d.z + md) / DEN
Else
u = -(MA * d.x + MB * d.y + mc * d.z + md)
End If
'Rückeinsetzen = Schnittpunkt:
r.x = d.x + u * ED.x
r.y = d.y + u * ED.y
r.z = d.z + u * ED.z
' Debug.Print "END INTERSECTION"
End Sub

------------------
Wer es nicht versucht, hat schon verlorn
Und bei 3 Typos gibts den vierten gratis !

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP