Source-Code - Fast 3D-Engine in Visual Basic .NET and DirectX11 - Schnelle 3D-Engine in Visual Basic .NET und DirectX11

Direkt zum Seiteninhalt

Hauptmenü

Source-Code

Main-Program Form1.vb:

Imports DX11Engine
Imports SlimDX
Imports SlimDX.Direct3D11
Imports System.ComponentModel
Imports System.IO

Public Class Form1

   Private WithEvents Timer1 As New Timer

   Private _DX11Device As DX11Engine.DX11Device
   Private _DisableRenderMethod As Boolean = True

   Private _Scene As DX11Engine.Scene5
   Private _MouseProvider As MouseProvider

   Private _ModelGeometry As GeometryData
   Private _ModelKanten1 As Kanten1Data
   Private _ModelKanten1b As Kanten1bData

   Private startx_old, starty_old As Integer


   Private _NodeMarker As NodeMarker

   Private _AxisSphere As AxisSphere

   Private _UcsIcon As UcsIcon
   Private _UcsIconX As Vector3
   Private _UcsIconY As Vector3
   Private _UcsIconZ As Vector3
   Private _UcsIconColorX As Color
   Private _UcsIconColorY As Color
   Private _UcsIconColorZ As Color

   Private _D2DTarget As Direct2D.RenderTarget
   Private _D2DBrush As Direct2D.SolidColorBrush

   Private _DWFont1 As DirectWrite.TextFormat                         ' refers to unmanaged resource, to dispose
   Private _DWLabelX As DirectWrite.TextLayout                        ' refers to unmanaged resource, to dispose
   Private _DWLabelY As DirectWrite.TextLayout                        ' refers to unmanaged resource, to dispose
   Private _DWLabelZ As DirectWrite.TextLayout                        ' refers to unmanaged resource, to dispose

   Private _SelectedFacet As Integer
   Private _SelectedVertex As Integer


   ' ###################################################################################
   ' #                             Programmstart
   ' ###################################################################################

   Public Sub New()

       ' Dieser Aufruf ist für den Designer erforderlich.
       InitializeComponent()

       ' Fügen Sie Initialisierungen nach dem InitializeComponent()-Aufruf hinzu.

       RenderPanel.Dock = DockStyle.Fill

       Call color_einlesen()

       ' RenderPanel.BackColor = Color.FromArgb(i1_hintergrund, i2_hintergrund, i3_hintergrund)

       Call netzwerk_einladen()

       ' jetzt letzter suchen
       Dim len1, jj As Integer
       sAppPath1 = System.AppDomain.CurrentDomain.BaseDirectory
       ChDrive(Mid$(sAppPath1, 1, 1))
       ChDir(sAppPath1)

       len1 = Len(sAppPath1) - 1
       For jj = len1 To 1 Step -1
           If Mid(sAppPath1, jj, 1) = "Then Exit For
       Next
       sAppPath1_haupt = sAppPath1

       knoten_modus = 0
       flaechen_modus = 0
       eg_modus = 1

       'automatische Einladung von STL-Files
       Call stl_txt_einladen

   End Sub


   Sub stl_txt_einladen()

       If Dir("stl.txt") <> "" Then
           Dim datei_ladena As New IO.FileInfo("stl.txt")
           Dim datei_laden2a As New IO.StreamReader("stl.txt")

           stl_txt = datei_laden2a.ReadLine
           MsgBox("STL.TXT-File found and load File : " & stl_txt)
           m8_einladen = 2
           datei_laden2a.Close()
           ' weiter in sub mouseinput/mouse_move
       End If

   End Sub


   Sub dx11_setup()

       Dim path_dx11 As String
       path_dx11 = System.AppDomain.CurrentDomain.BaseDirectory

       path_dx11 = path_dx11 + "DirectX11msi"
       MsgBox(path_dx11)

       ' jetzt starten
       Dim oProcess As Process
       If Dir(path_dx11) = "" Then
           MsgBox("DirectX11-Installation is not possible!")
           Exit Sub
       End If

       oProcess = System.Diagnostics.Process.Start(path_dx11)

   End Sub

   ''' <summary>
   ''' Handles the Load event. Creates the DirectX device and loads the scene object and dependencies.
   ''' </summary>
   Private Sub Form1_Load(sender As Object, e As EventArgs) Handles Me.Load

       If Not InitializeDevice() Then
           MsgBox("The creation of the DirectX 11 primary device failed." + vbCrLf + "Please update your video driver to the latest version." _
           + vbCrLf + "If this problem persists, please contact support.")
           Application.Exit()
           End

       End If

       If Not InitializeScene() Then
           MsgBox("The creation of the DirectX 11 environment failed." + vbCrLf + "Please update your video driver to the latest version." _
           + vbCrLf + "If this problem persists, please contact support.")
           Application.Exit()
           End
       End If

   End Sub

   ''' <summary>
   ''' Handles the Shown event. Sets up a timer that will periodically update the render viewport.
   ''' </summary>
   Private Sub Form1_Shown(sender As Object, e As EventArgs) Handles Me.Shown

       Timer1.Interval = 33
       Timer1.Start()

       _DisableRenderMethod = False

   End Sub

   ''' <summary>
   ''' Handles the FormClosing event. Free all resources here.
   ''' </summary>
   Private Sub Form1_FormClosing(sender As Object, e As FormClosingEventArgs) Handles Me.FormClosing

       _DX11Device.Dispose()

   End Sub

   ' ###################################################################################
   ' #                            Initialisierung
   ' ###################################################################################

   ''' <summary>
   ''' Initializes the Direct3D11 device.
   ''' </summary>
   Private Function InitializeDevice() As Boolean

#If DEBUG Then
       _DX11Device = New DX11Device(FeatureLevel.Level_11_0, FeatureLevel.Level_10_1, DeviceCreationFlags.None, True)
#Else
       _DX11Device = New DX11Device(FeatureLevel.Level_11_0, FeatureLevel.Level_10_1, DeviceCreationFlags.None, True)
#End If

       If _DX11Device.LastError <> EngineResult.OK Then

           If _DX11Device IsNot Nothing Then
               _DX11Device.Dispose()
               _DX11Device = Nothing
           End If

           Return False

       End If

       Return True

   End Function

   ''' <summary>
   ''' Initializes a basic Direct3D11 scene and the scene dependencies.
   ''' </summary>
   ''' <remarks>
   ''' The term Scene describes an empty environment with more or less functionality built in
   ''' that can be controlled with the scene properties and methods.
   '''
   ''' MouseProvider and CameraProvider are input objects that provide a conveniant way to move
   ''' around the scene.
   ''' </remarks>
   '''
   Private Function InitializeScene() As Boolean

       _Scene = New DX11Engine.Scene5(_DX11Device, RenderPanel)

       If _Scene.LastError <> EngineResult.OK Then
           Return False
       End If

       ' Set the background color of the scene
       ' Hintergrundfarbe setzen (nur für einfarbigen Hintergrund von Bedeutung)
       If i1_hintergrund > -1 Then
           _Scene.EnableBackground = False
           _Scene.ClearColor = Color.FromArgb(i1_hintergrund, i2_hintergrund, i3_hintergrund)
       Else
           _Scene.EnableBackground = True     ' schaltet den Farbverlauf ein (Standard, muß man nicht angeben)
       End If



       ' _Scene.EnableBackground = False

       ' ===========================================
       ' Create axis markers for better orientation.
       ' ===========================================

       _AxisSphere = New AxisSphere(_DX11Device, 0.5F, 72)

       ' ========================================================================
       ' Create a NodeMarker object to mark vertices (this is a 3DVBVIEW object).
       ' ========================================================================

       _NodeMarker = New NodeMarker(_DX11Device)

       ' =================================================================
       ' User Coordinate System Icon (will be displayed in the ChildView).
       ' =================================================================

       _UcsIconColorX = Color.FromArgb(200, 0, 0)
       _UcsIconColorY = Color.FromArgb(0, 180, 0)
       _UcsIconColorZ = Color.FromArgb(0, 0, 200)

       _UcsIcon = New UcsIcon(_DX11Device, 0.08F, _UcsIconColorX, _UcsIconColorY, _UcsIconColorZ)

       ' Save the world coordinates of the x, y and z arrows

       _UcsIconX = _UcsIcon.ArrowX
       _UcsIconY = _UcsIcon.ArrowY
       _UcsIconZ = _UcsIcon.ArrowZ

       ' Adjust the coordinates to a point somewhat ahead

       _UcsIconX.X = _UcsIconX.X + 0.3F
       _UcsIconY.Y = _UcsIconY.Y + 0.3F
       _UcsIconZ.Z = _UcsIconZ.Z + 0.3F

       ' ==================================
       ' Get the Direct2D target and brush.
       ' ==================================

       _D2DTarget = _Scene.Direct2DRenderTarget
       _D2DBrush = _Scene.Direct2DBrush

       ' ==============================================================
       ' Create Direct2D/DirectWrite TextFormat and TextLayout objects.
       ' ==============================================================

       Dim dwFactory As DirectWrite.Factory = _Scene.DirectWriteFactory

       _DWFont1 = New DirectWrite.TextFormat(dwFactory, "Arial", DirectWrite.FontWeight.Normal, DirectWrite.FontStyle.Normal, DirectWrite.FontStretch.Normal, 12, "en-US")
       _DWFont1.TextAlignment = DirectWrite.TextAlignment.Center
       _DWFont1.ParagraphAlignment = DirectWrite.ParagraphAlignment.Center

       ' *** Add more fonts here...
       ' *** Note: each new TextFormat requires a corresponding
       ' *** .dispose() call in the DisposeComObjects() method.

       _DWLabelX = New DirectWrite.TextLayout(dwFactory, "X", _DWFont1, 16, 16)
       _DWLabelY = New DirectWrite.TextLayout(dwFactory, "Y", _DWFont1, 16, 16)
       _DWLabelZ = New DirectWrite.TextLayout(dwFactory, "Z", _DWFont1, 16, 16)


       ' *** Add more layouts here...
       ' *** Note: each new TextLayout requires a corresponding
       ' *** .dispose() call in the DisposeComObjects() method.

       'Private _DWFont1 As DirectWrite.TextFormat                         ' refers to unmanaged resource, to dispose
       'Private _DWLabelX As DirectWrite.TextLayout                        ' refers to unmanaged resource, to dispose
       'Private _DWLabelY As DirectWrite.TextLayout                        ' refers to unmanaged resource, to dispose
       'Private _DWLabelZ As DirectWrite.TextLayout                        ' refers to unmanaged resource, to dispose


       _Scene.RightHanded = True



       ' =========================================================
       ' Create a MouseProvider object to handle the panel events.
       ' =========================================================

       _MouseProvider = New MouseProvider(RenderPanel, True)

       ' ================================================================================
       ' Add event handlers, to deal with mouse events and form or control resize events.
       ' ================================================================================

       AddHandler RenderPanel.Resize, AddressOf ResizeScene
       AddHandler _DX11Device.Disposing, AddressOf DisposeComObjects
       AddHandler _MouseProvider.OnControlMouseChanges, AddressOf MouseInput

       Return True

   End Function

   ' ###################################################################################
   ' #                       Maus und Form (Panel) Ereignisse
   ' ###################################################################################
   ''' <summary>
   ''' Handles the resize event of the RenderPanel control.
   ''' </summary>
   Private Sub ResizeScene(s As Object, e As EventArgs)

       _Scene.OnResize(RenderPanel.Width, RenderPanel.Height)

       _D2DTarget = _Scene.Direct2DRenderTarget
       _D2DBrush = _Scene.Direct2DBrush

       Me.Render()

   End Sub

   ''' <summary>
   ''' Frees unmanaged resources that are not handled by DX11Engine.
   ''' </summary>
   Private Sub DisposeComObjects()

       If (_DWFont1 IsNot Nothing) Then _DWFont1.Dispose()

       If (_DWLabelX IsNot Nothing) Then _DWLabelX.Dispose()
       If (_DWLabelY IsNot Nothing) Then _DWLabelY.Dispose()
       If (_DWLabelZ IsNot Nothing) Then _DWLabelZ.Dispose()

   End Sub





   ' wird benötigt für ein Maus-Move-Ereignis damit das Modell nach dem Einladen automatisch gezeichnet wird
   Public Sub Mausklick(Optional ByVal Button As _
     MouseButtons = MouseProvider.MouseEvents.RightDown, Optional ByVal XPos As Long = -1, Optional ByVal YPos As Long = -1)

       Const MOUSEEVENTF_ABSOLUTE = &H8000

       Const MOUSEEVENTF_MOVE = &H1

       ' Mauszeiger positionieren
       If XPos <> -1 Or YPos <> -1 Then
           mouse_event(MOUSEEVENTF_ABSOLUTE + MOUSEEVENTF_MOVE,
           XPos / My.Computer.Screen.Bounds.Width * 65535,
           YPos / My.Computer.Screen.Bounds.Height * 65535, 0, 0)
       End If

   End Sub


   Sub knoten_modus_ausgabe()

       If knoten_modus = 1 Then
           Dim knot3 As Integer = iface2

           If language = 0 Then
               ToolStripStatusLabel1.Text = "aktueller Knoten " + Str(knot3) + ": "
               ToolStripStatusLabel1.Text = ToolStripStatusLabel1.Text + " X-Koord.= " + Str(din8(knot3, 1)) + ";"
               ToolStripStatusLabel1.Text = ToolStripStatusLabel1.Text + " Y-Koord.=" + Str(din8(knot3, 2)) + ";"
               ToolStripStatusLabel1.Text = ToolStripStatusLabel1.Text + " Z-Koord.=" + Str(din8(knot3, 3))
           Else
               ToolStripStatusLabel1.Text = "current Node " + Str(knot3) + ": "
               ToolStripStatusLabel1.Text = ToolStripStatusLabel1.Text + " X-Coord.= " + Str(din8(knot3, 1)) + ";"
               ToolStripStatusLabel1.Text = ToolStripStatusLabel1.Text + " Y-Coord.=" + Str(din8(knot3, 2)) + ";"
               ToolStripStatusLabel1.Text = ToolStripStatusLabel1.Text + " Z-Coord.=" + Str(din8(knot3, 3))
           End If



       End If

   End Sub

   ' ###################################################################################
   ' #                Modellerzeugung  din8() -> Grafikpuffer
   ' ###################################################################################

   ''' <summary>
   ''' Converts the global arrays to Direct3D11 VertexBuffer and IndexBuffer.
   ''' </summary>
   Private Sub CreateOrUpdateModel()

       ' Linienmodell mit nelka, in7ka und din8
       If (_ModelKanten1 IsNot Nothing) Then _ModelKanten1.Dispose()
       If nelka > 0 Then
           _ModelKanten1 = New Kanten1Data(_DX11Device)
           If _ModelKanten1.LastError <> EngineResult.OK Then
               ' Fehlerbehandlung ...
               ' oder, im Zweifel, wieder zerstören
               If (_ModelKanten1 IsNot Nothing) Then _ModelKanten1.Dispose()
               _ModelKanten1 = Nothing
           End If

           _ModelKanten1b = New Kanten1bData(_DX11Device)
           If _ModelKanten1b.LastError <> EngineResult.OK Then
               ' Fehlerbehandlung ...
               ' oder, im Zweifel, wieder zerstören
               If (_ModelKanten1b IsNot Nothing) Then _ModelKanten1b.Dispose()
               _ModelKanten1b = Nothing
           End If
       End If


       ' normales modell mit nfla, kfl und din8
       If (_ModelGeometry IsNot Nothing) Then _ModelGeometry.Dispose()

       _ModelGeometry = New GeometryData(_DX11Device, VertexLayout.PositionNormalColored)

       If _ModelGeometry.LastError <> EngineResult.OK Then
           _ModelGeometry.Dispose()
           _ModelGeometry = Nothing
       End If

   End Sub


   ' ###################################################################################
   ' #                            Renderfunktion
   ' ###################################################################################


   Sub Render2()

       _NodeMarker.Clear()

       Me.CreateOrUpdateModel()

       If knoten_modus = 1 Then
           _NodeMarker.CreateRange(1, neck, 0.01)
       End If

       Render()

   End Sub

   ''' <summary>
   ''' Renders the scene.
   ''' </summary>
   Public Sub Render()

       If _DisableRenderMethod Then Exit Sub

       ' If nel = 0 Then Exit Sub

       If nel = 0 Then
           _Scene.Clear()
           _Scene.Present()
           Exit Sub
       End If


       ' Clear is required by DX11Engine

       _Scene.Clear()

       ' Begin3D is required by DX11Engine

       _Scene.Begin3D()

       ' Draw the axis marker. The sphere (trackball symbol) uses
       ' a transformation to stay at the center of the viewport.



       If RibbonCheckBox6.Checked = True Then
           ' Draw the main model

           ' drahtgitter wenn nur Balken dann keine Flächen erlaubt
           If RibbonCheckBox5.Checked = True Or in5(1, 3) = 11 Or RibbonCheckBox3.Checked = True Then
               ' Linien-Modus, ModelKanten1 von 1-16000 und ModelKanten2 von 16001 bis 32000 haben das gleiche VertexLayout, darum
               ' kann man das für beide vorab festlegen. Ausgabe des unveränderten
               ' Farbwerts da keine Normalen vorhanden.
               On Error GoTo zu
zu:
               If (_ModelKanten1 IsNot Nothing) Then
                   _ModelKanten1.Apply()
                   _Scene.SetShader(_ModelKanten1.Layout, ShaderPreset.PlainVertexColor)
                   _ModelKanten1.Draw()
               End If
               If (_ModelKanten1b IsNot Nothing) Then
                   _ModelKanten1b.Apply()
                   _Scene.SetShader(_ModelKanten1b.Layout, ShaderPreset.PlainVertexColor)
                   _ModelKanten1b.Draw()
               End If
               If in5(1, 3) = 11 Then GoTo zbalken
           End If

           'ohne netz und mit netz als flächenmodell
           If RibbonCheckBox3.Checked = True Or RibbonCheckBox4.Checked = True Then

               ' ModelGeometry enhält Flächennormalen, daher Ausgabe mit Licht, diffus
               ' unter Berücksichtigung des Drehsinns oder diffus ohne Berücksichtigung
               ' des Drehsinns (Max = beide Seiten beleuchtet, immer die hellere Seite anzeigen)
               If (_ModelGeometry IsNot Nothing) Then
                   _ModelGeometry.Apply()

                   ' mit schattierung aber ohne drehrichtung
                   _Scene.SetShader(_ModelGeometry.Layout, ShaderPreset.MaxVertexColor)

                   ' mit drehrichtung
                   '  _Scene.SetShader(_ModelGeometry.Layout, ShaderPreset.DiffuseVertexColor)

                   ' ohne normale immer gleiche farbe keine schatten
                   '_Scene.SetShader(_ModelGeometry.Layout, ShaderPreset.PlainVertexColor)

                   _ModelGeometry.Draw()
               End If

           End If

       Else
           On Error GoTo zbalken

           _ModelGeometry.Apply()

           'ohne netz und mit netz als flächenmodell
           If RibbonCheckBox3.Checked = True Or RibbonCheckBox4.Checked = True Then
               _Scene.SetShader(_ModelGeometry.Layout, ShaderPreset.MaxVertexColor)
               _ModelGeometry.Draw()
           End If

           ' nur als drahtgitter
           If RibbonCheckBox5.Checked = True Or RibbonCheckBox4.Checked = True Then
               _Scene.ModeBiasedWireframe()         ' Überlagerung ab DX-Machine Version 1075 jedoch nur für Fläche mit Netz
               '                _Scene.ModeWireframe()
               _Scene.ZTestOverlay()
               _Scene.SetMaterial(Color.FromArgb(0, 0, 0))
               _Scene.SetShader(_ModelGeometry.Layout, ShaderPreset.PlainColor)

               _ModelGeometry.Draw()
           End If
       End If



       ' Nur mit Fläche und Netz
       If RibbonCheckBox4.Checked = True Then


           _Scene.ModeBiasedWireframe()         ' Überlagerung ab DX-Machine Version 1075

           ' zeichnet unscharfes drahtgitter
           '  _Scene.ModeWireframe()               ' Netz alleine


           _Scene.ZTestOverlay()
           _Scene.SetMaterial(Color.FromArgb(0, 0, 0))

           _Scene.SetShader(_ModelGeometry.Layout, ShaderPreset.PlainColor)

           _ModelGeometry.Draw()

       End If


zbalken:


       If flaechen_modus = 1 Then               ' Facet/face selection active
               If _SelectedFacet > 0 Then


                   If eg_modus = 0 Then
                       _Scene.ModeSolid()
                       _Scene.ZTestOverlay()
                       _Scene.SetMaterial(Color.FromArgb(226, 0, 0))
                       _Scene.SetShader(_ModelGeometry.Layout, ShaderPreset.PlainColor)
                       ' fläche
                       _ModelGeometry.DrawFacet(_SelectedFacet)

                   End If

               End If

           ElseIf knoten_modus = 1 Then             ' Node/vertex selection active

               If _NodeMarker.RangeExists = True Then

                   ' NodeMarker is a geometry object, it must be applied first
                   ' (replace the model geometry)

                   _NodeMarker.Apply()

                   _Scene.ModeSolid()
                   _Scene.ZTestEnabled()
                   _Scene.SetMaterial(Color.FromArgb(92, 92, 92))
                   _Scene.SetShader(_NodeMarker.Layout, ShaderPreset.PlainColor)

                   _NodeMarker.Draw()

                   ' If a node/vertex is selected, redraw it using a different color

                   If _SelectedVertex > 0 Then

                       ' _Scene.ModeSolid()                                             ' still active
                       _Scene.ZTestOverlay()
                       _Scene.SetMaterial(Color.FromArgb(255, 0, 0))
                       ' _Scene.SetShader(_NodeMarker.Layout, ShaderPreset.PlainColor)  ' still active

                       _NodeMarker.DrawVertex(_SelectedVertex)

                   End If
               End If

           End If


       ' Select the ChildView and draw the UCS icon




       _Scene.SetRenderTarget(1)


       '   If RibbonCheckBox2.Checked = True Then
       If _UcsIcon IsNot Nothing Then
               _UcsIcon.Apply()
               _Scene.ModeSolid()
               _Scene.ZTestEnabled()
               _Scene.SetShader(_UcsIcon.Layout, ShaderPreset.DiffuseVertexColor)
               _UcsIcon.Draw()
           End If
       '  End If


       ' End3D is required by DX11Engine

       _Scene.End3D()

       ' ======================================
       ' Intermediate code
       ' ======================================

       ' Get the MainView pixel coordinates of the given ChildView world coordinates

       Dim px As Point = _Scene.ChildViewProject(_UcsIconX)
       Dim py As Point = _Scene.ChildViewProject(_UcsIconY)
       Dim pz As Point = _Scene.ChildViewProject(_UcsIconZ)

       ' ======================================
       ' Direct2D
       ' ======================================

       ' Begin2D is required by DX11Engine

       _Scene.Begin2D()

       ' BeginDraw is required by Direct2D

       _D2DTarget.BeginDraw()

       ' The clear color (0,0,0,0) is required to blend the 2D background buffer
       ' to the Direct3D target, it's not the color of the viewport (RenderPanel).

       _D2DTarget.Clear(New Color4(0, 0, 0, 0))

       ' Output the UcsIcon labels. The layout was created with centered text within
       ' a 16x16 pixel rectangle.

       _D2DBrush.Color = _UcsIconColorX
       _D2DTarget.DrawTextLayout(New Point(px.X - 8, px.Y - 8), _DWLabelX, _D2DBrush)
       _D2DBrush.Color = _UcsIconColorY
       _D2DTarget.DrawTextLayout(New Point(py.X - 8, py.Y - 8), _DWLabelY, _D2DBrush)
       _D2DBrush.Color = _UcsIconColorZ
       _D2DTarget.DrawTextLayout(New Point(pz.X - 8, pz.Y - 8), _DWLabelZ, _D2DBrush)



       ' Draw some text. DrawText internally creates a TextLayout before rendering, if
       ' the text is static, using a predefined TextLayout object needs less computing
       ' power.

       ' Dim text As String = "3DVBVIEW"
       ' Me.Text = "CAD-Viewer 3DVBVIEW für DirectX11"

       _D2DBrush.Color = Color.FromArgb(0, 0, 0)

       ' _D2DTarget.DrawText(text, _DWFont1, New Rectangle(0, 0, 100, 16), _D2DBrush)

       ' EndDraw is required by Direct2D

       _D2DTarget.EndDraw()

       ' End2D is required by DX11Engine

       _Scene.End2D()

       ' Present is required by DXGI

       _Scene.Present()



   End Sub

   ' ###################################################################################
   ' #                         Knoten und Flächenerkennung
   ' ###################################################################################

   ''' <summary>
   ''' Returns the facet 'under' the given (mouse) position.
   ''' </summary>
   ''' <remarks>
   ''' The camera ray directs from the camera origin to the mouse cursor.
   ''' </remarks>
   Private Function FindFacet(PosX As Integer, PosY As Integer) As Integer

       Dim pickray As Ray
       pickray = _Scene.GetCameraRay(PosX, PosY)

       Dim v1 As Vector3
       Dim v2 As Vector3
       Dim v3 As Vector3

       Dim dist As Single
       Dim mindist As Single = 1000000.0F
       Dim picked As Integer

       Dim i, j As Integer

       For i = 1 To nfla
           j = le(i)
           If in5(j, 4) = -1 Then GoTo nextii

           v1.X = (din8(kfl(i, 1), 1) - xe_za) / xmaxver
           v1.Y = (din8(kfl(i, 1), 2) - ye_za) / xmaxver
           v1.Z = (din8(kfl(i, 1), 3) - ze_za) / xmaxver

           v2.X = (din8(kfl(i, 2), 1) - xe_za) / xmaxver
           v2.Y = (din8(kfl(i, 2), 2) - ye_za) / xmaxver
           v2.Z = (din8(kfl(i, 2), 3) - ze_za) / xmaxver

           v3.X = (din8(kfl(i, 3), 1) - xe_za) / xmaxver
           v3.Y = (din8(kfl(i, 3), 2) - ye_za) / xmaxver
           v3.Z = (din8(kfl(i, 3), 3) - ze_za) / xmaxver


           If Ray.Intersects(pickray, v1, v2, v3, dist) Then

               If dist < mindist Then
                   picked = i
                   mindist = dist
                   iface2 = i
               End If

           End If
Nextii:
       Next

       Render()

       Return picked

   End Function

   ''' <summary>
   ''' Returns the vertex 'under' the given (mouse) position.
   ''' </summary>
   ''' <remarks>
   ''' Projects each vertex from world to screen coordinates and test if it's near the mouse position.
   ''' If it's within a given distance to the mouse, the world space distance to the camera is eval-
   ''' uated, the vertex that is nearest to the camera is returned.
   ''' </remarks>
   Private Function FindVertex(PosX As Integer, PosY As Integer) As Integer

       ' Unprojects the camera position (0,0,0) to world space.

       Dim invView As Matrix
       Dim camZero As Vector3

       invView = Matrix.Invert(_Scene.View)
       camZero = Vector3.TransformCoordinate(New Vector3(), invView)

       ' Projection matrix for the world to screen transformation

       Dim viewProj As Matrix
       viewProj = _Scene.ViewProjection

       Dim v1 As Vector3
       Dim v2 As Vector3

       Dim dist1 As Integer
       Dim dist2 As Single
       Dim mindist As Single = 1000000.0F
       Dim picked As Integer

       Dim i As Integer

       For i = 1 To neck

           v1.X = (din8(i, 1) - xe_za) / xmaxver
           v1.Y = (din8(i, 2) - ye_za) / xmaxver
           v1.Z = (din8(i, 3) - ze_za) / xmaxver

           v2 = Vector3.Project(v1, 0, 0, RenderPanel.Width, RenderPanel.Height, 0.0F, 1.0F, viewProj)

           dist1 = ScreenDistance(v2.X, v2.Y, PosX, PosY)

           ' If screen distance to the mouse < 10 pixels, test vertex to camera distance    

           If dist1 < 10 Then

               dist2 = WorldDistance(camZero, v1)

               If dist2 < mindist Then
                   picked = i
                   iface2 = i
                   mindist = dist2
               End If

               ' Diagnostics.Debug.Print("Picked: " & i.ToString & " d1 " & dist1.ToString & " d2 " & dist2.ToString)

           End If

       Next

       Render()

       Return picked

   End Function


   Sub ibe_erstellen()

       Dim i, k1, k2, k3 As Integer
       Dim a1, a2, a3 As Single
       Dim viewProj As Matrix
       viewProj = _Scene.ViewProjection

       Dim v1 As Vector3
       Dim v2 As Vector3

       If rechteck_aufziehen = 10 Then

           rechteck_aufziehen = 0
           nber = 0
           ReDim ibe(neck + nel)

           nber = 0

           On Error GoTo n3

           For i = 1 To nel

               k1 = in7(i, 1)
               k2 = in7(i, 2)
               k3 = in7(i, 3)

               If k3 > 0 Then
                   a1 = ((din8(k1, 1) + din8(k2, 1) + din8(k3, 1)) / 3 - xe_za) / xmaxver
                   a2 = ((din8(k1, 2) + din8(k2, 2) + din8(k3, 2)) / 3 - ye_za) / xmaxver
                   a3 = ((din8(k1, 3) + din8(k2, 3) + din8(k3, 3)) / 3 - ze_za) / xmaxver
               Else
                   a1 = ((din8(k1, 1) + din8(k2, 1)) / 2 - xe_za) / xmaxver
                   a2 = ((din8(k1, 2) + din8(k2, 2)) / 2 - ye_za) / xmaxver
                   a3 = ((din8(k1, 3) + din8(k2, 3)) / 2 - ze_za) / xmaxver
               End If

               v1.X = a1
               v1.Y = a2
               v1.Z = a3

               v2 = Vector3.Project(v1, 0, 0, RenderPanel.Width, RenderPanel.Height, 0.0F, 1.0F, viewProj)

               startx = v2.X 'vector1.X
               starty = v2.Y 'vector1.Y

               ' vergleichen ob
               If startx >= xmin_reck And startx < xmax_reck Then
                   If starty >= ymin_reck And starty < ymax_reck Then
                       nber = nber + 1
                       ibe(nber) = i
                       'MsgBox("nber " & nber & " " & i)
                   End If
               End If
nexti2:
           Next i

n3:

           If nber = 0 Then xmaxver = xmaxver / 2 : GoTo next2

           Dim xa, xe, ya, ye, za, ze As Single
           Dim xae, yae, zae As Single

           xa = 10000000
           xe = -xa
           ya = xa
           ye = xe
           za = xa
           ze = xe

           If nber = 0 Then Exit Sub

           For i = 1 To nber
               k1 = ibe(i)
               If k1 = 0 Then GoTo nextk3
               For k2 = 1 To 3
                   k3 = in7(k1, k2)
                   If k3 = 0 Then GoTo nextk2
                   a1 = din8(k3, 1)
                   a2 = din8(k3, 2)
                   a3 = din8(k3, 3)
                   If xa > a1 Then xa = a1
                   If xe < a1 Then xe = a1
                   If ya > a2 Then ya = a2
                   If ye < a2 Then ye = a2
                   If za > a3 Then za = a3
                   If ze < a3 Then ze = a3
nextk2:
               Next k2
nextk3:
           Next i

           xae = (xa + xe) / 2
           yae = (ya + ye) / 2
           zae = (za + ze) / 2

           xe_za = xae
           ye_za = yae
           ze_za = zae

           xae = Math.Abs(xa - xe) * _Scene.Rotation.X
           yae = Math.Abs(ya - ye) * _Scene.Rotation.Y
           zae = Math.Abs(za - ze) * _Scene.Rotation.Z


           xmaxver = Math.Abs(xae)
           If xmaxver < Math.Abs(yae) Then xmaxver = Math.Abs(yae)
           If xmaxver < Math.Abs(zae) Then xmaxver = Math.Abs(zae)


           'MsgBox("xae " & xae & " yae " & yae & " zae " & zae & " xmaxver " & xmaxver)

next2:
           rechteck_aufziehen = 0
           Call vorige_ansicht_sichern()
           Render2()

           Exit Sub
       End If


       Dim jj As Integer = 0

       For i = 1 To nel

           If in5(le(i), 4) = -1 Then GoTo nexti

           k1 = in7(i, 1)
           k2 = in7(i, 2)
           k3 = in7(i, 3)

           a1 = ((din8(k1, 1) + din8(k2, 1) + din8(k3, 1)) / 3 - xe_za) / xmaxver
           a2 = ((din8(k1, 2) + din8(k2, 2) + din8(k3, 2)) / 3 - ye_za) / xmaxver
           a3 = ((din8(k1, 3) + din8(k2, 3) + din8(k3, 3)) / 3 - ze_za) / xmaxver

           v1.X = a1
           v1.Y = a2
           v1.Z = a3

           v2 = Vector3.Project(v1, 0, 0, RenderPanel.Width, RenderPanel.Height, 0.0F, 1.0F, viewProj)

           startx = v2.X 'vector1.X
           starty = v2.Y 'vector1.Y

           ' vergleichen ob
           If startx >= xmin_reck And startx < xmax_reck Then
               If starty >= ymin_reck And starty < ymax_reck Then
                   le(i) = ngr_neu
                   jj = jj + 1
               End If
           End If
nexti:
       Next i

       RibbonPanel4.Text = "Neue oder alte Baugruppe " + Str(ngr_neu) + " mit " & Str(jj) + " neuen Triangles wurde erzeugt"

       If ngr_neu > ngrup Then ngrup = ngr_neu

       'neue baugruppe erzeugen
       For i = 1 To 6
           in5(ngr_neu, i) = in5(1, i)
       Next

       Dim i11, i1, i2, i3 As Integer
       i11 = in5(ngr_neu, 6)
       i1 = Int(i11 / 65536)
       i2 = Int((i11 - (65536 * i1)) / 256)
       i3 = Int(i11 - (65536 * i1 + 256 * i2))

       in5(ngr_neu, 6) = RGB(i1, i2, i3)
       in5(ngr_neu, 7) = i1
       in5(ngr_neu, 8) = i2
       in5(ngr_neu, 9) = i3
       eg.Close()
       eg.Show()

       Render2()


   End Sub





   ''' <summary>
   ''' Returns the distance of two points in 2D space (within the render panel).
   ''' </summary>
   Private Function ScreenDistance(x1 As Single, y1 As Single, x2 As Integer, y2 As Integer) As Integer

       If (x1 < 0) Or (y1 < 0) Then
           Return Integer.MaxValue
       ElseIf (x1 > RenderPanel.Width) Or (y1 > RenderPanel.Height) Then
           Return Integer.MaxValue
       End If

       Dim difx As Integer = x1 - x2
       Dim dify As Integer = y1 - y2

       Return CInt(Math.Sqrt(difx * difx + dify * dify))

   End Function

   ''' <summary>
   ''' Returns the distance of two points in 3D space.
   ''' </summary>
   Private Function WorldDistance(vec1 As Vector3, vec2 As Vector3) As Single

       Dim diff As Vector3 = Vector3.Subtract(vec1, vec2)

       Return Math.Sqrt(diff.X * diff.X + diff.Y * diff.Y + diff.Z * diff.Z)

   End Function

   ' ###################################################################################
   ' #                                      ENDE
   ' ###################################################################################




   '//#########################################
   '//Menu Change Light Settings
   '//#########################################
   Private Sub LightColorClick(sender As Object, e As EventArgs)

       Dim tsmi As ToolStripMenuItem = CType(sender, ToolStripMenuItem)
       _Scene.LightColor = tsmi.BackColor

   End Sub



   '//#########################################
   '//Menu CameraLight
   '//#########################################

   Private Sub tsbCamLight_Click(sender As Object, e As EventArgs)
       Render()
   End Sub


   Sub color_einlesen()

       Dim sAppPath1 As String
       sAppPath1 = System.AppDomain.CurrentDomain.BaseDirectory
       ChDrive(Mid$(sAppPath1, 1, 1))
       ChDir(sAppPath1)
       Dim text As String = "color"

       If Dir(text) <> "" Then
           Dim datei_laden As New IO.FileInfo(text)
           Dim datei As New IO.StreamReader(text)

           i1_modell = Val(datei.ReadLine)
           i2_modell = Val(datei.ReadLine)
           i3_modell = Val(datei.ReadLine)

           i1_hintergrund = Val(datei.ReadLine)
           i2_hintergrund = Val(datei.ReadLine)
           i3_hintergrund = Val(datei.ReadLine)

           datei.Close()
       End If

   End Sub

   Sub netzwerk_einladen()
       ' zulässige Grenzen
       ' 1 = means-lite
       ' 2 = means-design
       ' 3 = means-profi
       ' 4 = means-unlimited
       ' 5 = means-high end

       means_version = 5

       If means_version = 2 Then
           nmin_zul = 90000
           nmi_zul = 90000 ' statt 25000
       End If

       If means_version = 3 Then
           nmin_zul = 100000
           nmi_zul = 150000
       End If

       If means_version = 5 Then
           nmin_zul = din8zulaessig
           nmi_zul = in7zulaessig
       End If


       Dim sAppPath1 As String
       sAppPath1 = System.AppDomain.CurrentDomain.BaseDirectory
       ChDrive(Mid$(sAppPath1, 1, 1))
       ChDir(sAppPath1)


       netzwerk_path = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) + "ds.ini"

       Dim i1, i2, i3, j As Integer

       Dim len1, jj As Integer
       len1 = Len(sAppPath1) - 1
       For jj = len1 To 1 Step -1
           If Mid(sAppPath1, jj, 1) = "Then Exit For
       Next

       sAppPath1 = Mid(sAppPath1, 1, jj - 1)

       If Dir(netzwerk_path) = "" Then

           ' MsgBox("nicht da")
           meansstruktur = sAppPath1 + "
           meansprinter = sAppPath1 + "
           meansstl = sAppPath1 + "
           meansdxf = sAppPath1 + "
           meansstep = sAppPath1 + "
           means3ds = sAppPath1 + "
           meansanimation = sAppPath1 + "

       Else
           Dim datei_laden3 As New IO.FileInfo(netzwerk_path)
           Dim datei As New IO.StreamReader(netzwerk_path)
           meansstruktur = datei.ReadLine
           meansprinter = datei.ReadLine
           meansstl = datei.ReadLine
           meansdxf = datei.ReadLine
           meansstep = datei.ReadLine
           means3ds = datei.ReadLine

           meansstruktur = Trim(meansstruktur)
           meansprinter = Trim(meansprinter)
           meansstl = Trim(meansstl)
           meansdxf = Trim(meansdxf)
           meansstep = Trim(meansstep)
           means3ds = Trim(means3ds)

           meansanimation = sAppPath1 + "

           On Error GoTo zf

           wert = datei.ReadLine
           meintrag = datei.ReadLine
           'MsgBox(meintrag)
           'MsgBox("ist da")

           If meintrag < 0 Then
               meintrag = Math.Abs(meintrag)
               If meintrag > 0 Then meintrag = 0
           End If

           For i = 1 To meintrag
               meineintrag(i) = datei.ReadLine
           Next i

           For i = 1 To meintrag
               j = meintrag - i + 1
               If i = 1 Then
                   RibbonComboBox2.TextBoxText = " 1.   " + meineintrag(j)
                   RibbonLabel5.Text = " 1.   " + meineintrag(j)
               End If

               If i = 2 Then
                   RibbonLabel6.Text = " 2.   " + meineintrag(j)
               End If

               If i = 3 Then
                   RibbonLabel7.Text = " 3.   " + meineintrag(j)
               End If
               If i = 4 Then
                   RibbonLabel8.Text = " 4.   " + meineintrag(j)
               End If
               If i = 5 Then
                   RibbonLabel9.Text = " 5.   " + meineintrag(j)
               End If
           Next i

           On Error GoTo zf



           GoTo zff
zf:


zff:        datei.Close()


       End If


   End Sub


   Sub netzwerk_sichern()

       Dim sAppPath1 As String


       On Error GoTo zu

       ' neues netzwerk erzeuen
       Dim datei_laden As New IO.FileInfo(netzwerk_path)
       Dim datei_sichern2 As New IO.StreamWriter(netzwerk_path)
       GoTo zuu
zu:
       MsgBox("path failed")
       Exit Sub
zuu:



       datei_sichern2.WriteLine(meansstruktur)
       datei_sichern2.WriteLine(meansprinter)
       datei_sichern2.WriteLine(meansstl)
       datei_sichern2.WriteLine(meansdxf)
       datei_sichern2.WriteLine(meansstep)
       datei_sichern2.WriteLine(means3ds)
       datei_sichern2.WriteLine("0.001")
       Dim i As Integer

       If neck = 0 Then GoTo zum

       If meintrag = 5 Then
           meintrag = 4
           For i = 1 To 4
               meineintrag(i) = meineintrag(i + 1)
           Next
       End If

       If meintrag < 5 And meintrag >= 0 Then
           Dim len1 As Integer = Len(meansdatei)
           Dim len11 As Integer
           Dim len2 As Integer = Len(meineintrag(meintrag))
           Dim len22 As Integer

           ' schauen wieviele leerzeichen am anfang sind
           len11 = 0
           For i = 1 To len1 - 1
               If Mid(meansdatei, i, 1) = " " Then len11 = len11 + 1
           Next

           Dim j, ija As Integer
           ija = 0
           ' jetzt meansdatei mit allen einträgen vergleichen
           For j = 1 To meintrag
               len22 = 0
               For i = 1 To len2 - 1
                   If Mid(meineintrag(j), i, 1) = " " Then len22 = len22 + 1
               Next

               ' abfrage ob eintrag schon vorhanden ist
               If Mid(meansdatei, len11 + 1, len1) = Mid(meineintrag(j), len22 + 1, len2) Then ija = 1
           Next j
           If ija = 0 Then
               '    MsgBox("ja")
               meintrag = meintrag + 1
               meineintrag(meintrag) = meansdatei
           End If
       End If

       If meintrag = 0 Then
           meintrag = 1
           meineintrag(meintrag) = meansdatei
       End If

zum:

       datei_sichern2.WriteLine(meintrag)

       If meintrag > 0 Then
           For i = 1 To meintrag
               datei_sichern2.WriteLine(meineintrag(i))
           Next
       End If

       datei_sichern2.Close()

   End Sub


   Sub color_sichern()

       Dim sAppPath1 As String
       sAppPath1 = System.AppDomain.CurrentDomain.BaseDirectory
       ChDrive(Mid$(sAppPath1, 1, 1))
       ChDir(sAppPath1)
       Dim text As String = "color"

       ' color erzeuen
       Dim datei_laden As New IO.FileInfo(text)
       Dim datei_sichern As New IO.StreamWriter(text)

       datei_sichern.WriteLine(Str(i1_modell))
       datei_sichern.WriteLine(Str(i2_modell))
       datei_sichern.WriteLine(Str(i3_modell))

       datei_sichern.WriteLine(Str(i1_hintergrund))
       datei_sichern.WriteLine(Str(i2_hintergrund))
       datei_sichern.WriteLine(Str(i3_hintergrund))

       datei_sichern.Close()

   End Sub


   ' FEM und MUP einladen
   Private Sub RibbonButton12_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles RibbonButton12.Click
       step2stl_umwandeln = 0
       import.Show()

   End Sub

   ' MUP sichern
   Private Sub RibbonButton14_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles RibbonButton14.Click
       Call sichern()
       Render()
   End Sub


   ' MUP-Datei zeigen
   Private Sub Ribbonlabel2_Click(ByVal sender As Object, ByVal e As EventArgs) Handles RibbonLabel2.Click

       Dim proc As New Process

       With proc.StartInfo
           .FileName = "editor.exe"
           .Arguments = datei_name
           .UseShellExecute = True
           .Verb = "open"
       End With

       If Dir("editor.exe") <> "" Then
           proc.Start()
       Else
           MsgBox("Editor.exe oder Datei nicht gefunden: " & datei_name)
       End If

   End Sub



   ' beenden
   Private Sub RibbonButton5_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles RibbonButton5.Click

       Call netzwerk_sichern()
       Application.Exit()
       End

   End Sub



   'HL ohne Netz
   Private Sub RibbonCheckbox3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles RibbonCheckBox3.Click

       If RibbonCheckBox3.Checked = False Then
           RibbonCheckBox3.Checked = True
           RibbonCheckBox4.Checked = False
           RibbonCheckBox5.Checked = False
       End If
       Render2()

   End Sub

   'HL mit Netz
   Private Sub RibbonCheckbox4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles RibbonCheckBox4.Click

       If RibbonCheckBox4.Checked = False Then
           RibbonCheckBox4.Checked = True
           RibbonCheckBox3.Checked = False
           RibbonCheckBox5.Checked = False
       End If
       Render2()

   End Sub

   ' baugruppen-icon
   Private Sub Ribbonbutton25_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles RibbonButton25.Click
       RibbonCheckBox9.Checked = False
       Call baugruppen_modus_aktivieren()
       eg.Show()
   End Sub

   ' knoten-icon
   Private Sub Ribbonbutton24_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles RibbonButton24.Click
       RibbonCheckBox8.Checked = False
       Call knoten_modus_aktivieren()
   End Sub


   'knoten-modus
   Private Sub RibbonCheckbox8_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles RibbonCheckBox8.Click
       Call knoten_modus_aktivieren()
   End Sub


   Sub knoten_modus_aktivieren()
       If RibbonCheckBox8.Checked = False Then
           RibbonCheckBox8.Checked = True

           RibbonCheckBox9.Checked = False

           flaechen_modus = 0
           knoten_modus = 1
           eg_modus = 0
           ToolStripStatusLabel1.Text = "Knoten-Modus eingeschaltet"

       Else
           ToolStripStatusLabel1.Text = "Knoten-Modus ausgeschaltet"
           flaechen_modus = 0
           knoten_modus = 0
           eg_modus = 0
           RibbonCheckBox8.Checked = False
           RibbonCheckBox7.Checked = False
           RibbonCheckBox9.Checked = False
       End If
       Render2()
   End Sub

   'baugruppen-modus
   Private Sub RibbonCheckbox9_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles RibbonCheckBox9.Click
       Call baugruppen_modus_aktivieren()
   End Sub



   Sub baugruppen_modus_aktivieren_alt()
       If RibbonCheckBox9.Checked = False Then
           RibbonCheckBox9.Checked = True
           ' alle anderen aus

           RibbonCheckBox8.Checked = False
           RibbonCheckBox7.Checked = False

           flaechen_modus = 0
           knoten_modus = 0
           eg_modus = 1

           ToolStripStatusLabel1.Text = "Baugruppen-Modus eingeschaltet"
       Else
           ToolStripStatusLabel1.Text = "Baugruppen-Modus ausgeschaltet"
           flaechen_modus = 0
           knoten_modus = 0
           eg_modus = 0

           RibbonCheckBox8.Checked = False
           RibbonCheckBox7.Checked = False
           RibbonCheckBox9.Checked = False

       End If
       Render2()
   End Sub


   Sub baugruppen_modus_aktivieren()

       RibbonCheckBox9.Checked = True
       RibbonCheckBox8.Checked = False
       RibbonCheckBox7.Checked = False

       ' alle anderen aus

       RibbonCheckBox8.Checked = False
       RibbonCheckBox7.Checked = False

       If edge_modus_an = 1 Then
           edge_modus_an = 0
           Dim i1 As Integer
           For i = 1 To nel
               i1 = le(i)
               le(i) = in7(i, 4)
               in7(i, 4) = i1
           Next
           ngrup = 0
           For i = 1 To nel
               If le(i) > ngrup Then ngrup = le(i)
           Next

           For i = 1 To ngrup
               For j = 1 To 9
                   in5(i, j) = in55(i, j)
               Next
           Next


       End If

       flaechen_modus = 0
       knoten_modus = 0
       eg_modus = 1

       ToolStripStatusLabel1.Text = "Part-Modus"

       eg.Close()
       eg.Show()
       Render2()

   End Sub


   Sub edge_modus_aktivieren()

       RibbonCheckBox9.Checked = True
       RibbonCheckBox8.Checked = False
       RibbonCheckBox7.Checked = False

       edge_modus_an = 1

       Dim i1 As Integer
       For i = 1 To nfla
           i1 = le(i)
           le(i) = in7(i, 4)
           in7(i, 4) = i1
       Next

       ' alle in5 farben übertragen
       ReDim in55(ngrup, 9)
       For i = 1 To ngrup
           For j = 1 To 9
               in55(i, j) = in5(i, j)
           Next
       Next

       ngrup = 0
       For i = 1 To nel
           If le(i) > ngrup Then ngrup = le(i)
       Next

       Dim nk1, nk2 As Integer

       For i = 1 To nfla
           nk2 = in7(i, 4)
           nk1 = le(i)
           in5(nk1, 7) = in55(nk2, 7)
           in5(nk1, 8) = in55(nk2, 8)
           in5(nk1, 9) = in55(nk2, 9)
           in5(nk1, 6) = in55(nk2, 6)

       Next

       flaechen_modus = 0
       knoten_modus = 0
       eg_modus = 1

       ToolStripStatusLabel1.Text = "Edge-Modus"

       eg.Close()
       eg.Show()
       Render2()

   End Sub


   'triangle-modus
   Private Sub RibbonCheckbox7_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles RibbonCheckBox7.Click

       If RibbonCheckBox7.Checked = False Then
           RibbonCheckBox7.Checked = True

           RibbonCheckBox9.Checked = False
           RibbonCheckBox8.Checked = False

           flaechen_modus = 1
           knoten_modus = 0
           eg_modus = 0
           ToolStripStatusLabel1.Text = "Triangle-Modus eingeschaltet"
       Else
           ToolStripStatusLabel1.Text = "Triangle-Modus ausgeschaltet"
           flaechen_modus = 0
           knoten_modus = 0
           eg_modus = 0
           RibbonCheckBox8.Checked = False
           RibbonCheckBox7.Checked = False
           RibbonCheckBox9.Checked = False
       End If
       Render2()

   End Sub


   Private Sub RibbonCheckbox5_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles RibbonCheckBox5.Click

       If RibbonCheckBox5.Checked = False Then
           RibbonCheckBox5.Checked = True
           RibbonCheckBox3.Checked = False
           RibbonCheckBox4.Checked = False
       End If
       Render2()

   End Sub

   'Drahtgitter mit Netz
   Private Sub RibbonCheckbox6_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles RibbonCheckBox6.Click

       If RibbonCheckBox6.Checked = False Then
           RibbonCheckBox6.Checked = True

       Else
           RibbonCheckBox6.Checked = False

       End If

       Render2()

   End Sub

   ' pfade
   Private Sub RibbonButton18_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles RibbonButton18.Click
       pfade.Show()
       Render()
   End Sub

   ' export
   Private Sub RibbonButton8_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles RibbonButton8.Click
       export_sichern
       Render()
   End Sub


   ' dateiname
   Private Sub Ribbonlabel5_Click(ByVal sender As Object, ByVal e As EventArgs) Handles RibbonLabel5.Click
       datei_name = Mid(RibbonLabel5.Text, 6, Len(RibbonLabel5.Text))
       wert_2 = 1
       If datei_name <> "" Then Call einladen()
   End Sub

   ' dateiname
   Private Sub Ribbonlabel6_Click(ByVal sender As Object, ByVal e As EventArgs) Handles RibbonLabel6.Click
       datei_name = Mid(RibbonLabel6.Text, 6, Len(RibbonLabel6.Text))
       wert_2 = 1
       If datei_name <> "" Then Call einladen()
   End Sub

   Private Sub Ribbonlabel7_Click(ByVal sender As Object, ByVal e As EventArgs) Handles RibbonLabel7.Click
       datei_name = Mid(RibbonLabel7.Text, 6, Len(RibbonLabel7.Text))
       wert_2 = 1
       If datei_name <> "" Then Call einladen()
   End Sub

   Private Sub Ribbonlabel8_Click(ByVal sender As Object, ByVal e As EventArgs) Handles RibbonLabel8.Click
       datei_name = Mid(RibbonLabel8.Text, 6, Len(RibbonLabel8.Text))
       wert_2 = 1
       If datei_name <> "" Then Call einladen()
   End Sub

   Private Sub Ribbonlabel9_Click(ByVal sender As Object, ByVal e As EventArgs) Handles RibbonLabel9.Click
       datei_name = Mid(RibbonLabel9.Text, 6, Len(RibbonLabel9.Text))
       wert_2 = 1
       If datei_name <> "" Then Call einladen()
   End Sub


   ' 0%
   Private Sub Ribbonlabel4_Click(ByVal sender As Object, ByVal e As EventArgs) Handles RibbonLabel4.Click
       beleuchtungs_staerke = 0
       Call beleuchtung_ausschalten()
       Render2()
   End Sub

   ' 10%
   Private Sub Ribbonlabel10_Click(ByVal sender As Object, ByVal e As EventArgs) Handles RibbonLabel10.Click
       beleuchtungs_staerke = 10
       Call beleuchtung_ausschalten()
   End Sub

   ' 20%
   Private Sub Ribbonlabel11_Click(ByVal sender As Object, ByVal e As EventArgs) Handles RibbonLabel11.Click
       beleuchtungs_staerke = 20
       Call beleuchtung_ausschalten()
   End Sub

   ' 30%
   Private Sub Ribbonlabel15_Click(ByVal sender As Object, ByVal e As EventArgs) Handles RibbonLabel15.Click
       beleuchtungs_staerke = 30
       Call beleuchtung_ausschalten()
   End Sub

   ' 40%
   Private Sub Ribbonlabel16_Click(ByVal sender As Object, ByVal e As EventArgs) Handles RibbonLabel16.Click
       beleuchtungs_staerke = 40
       Call beleuchtung_ausschalten()
   End Sub

   ' 50%
   Private Sub Ribbonlabel17_Click(ByVal sender As Object, ByVal e As EventArgs) Handles RibbonLabel17.Click
       beleuchtungs_staerke = 50
       Call beleuchtung_ausschalten()
   End Sub

   ' 60%
   Private Sub Ribbonlabel18_Click(ByVal sender As Object, ByVal e As EventArgs) Handles RibbonLabel18.Click
       beleuchtungs_staerke = 60
       Call beleuchtung_ausschalten()
   End Sub

   ' 70%
   Private Sub Ribbonlabel34_Click(ByVal sender As Object, ByVal e As EventArgs) Handles RibbonLabel34.Click
       beleuchtungs_staerke = 70
       Call beleuchtung_ausschalten()
   End Sub


   Sub beleuchtung_ausschalten()

       Dim beleuchtungs_staerke2 As Single = 1.0

       If beleuchtungs_staerke = 10 Then beleuchtungs_staerke2 = 0.92
       If beleuchtungs_staerke = 20 Then beleuchtungs_staerke2 = 0.8
       If beleuchtungs_staerke = 30 Then beleuchtungs_staerke2 = 0.7
       If beleuchtungs_staerke = 40 Then beleuchtungs_staerke2 = 0.6
       If beleuchtungs_staerke = 50 Then beleuchtungs_staerke2 = 0.5
       If beleuchtungs_staerke = 60 Then beleuchtungs_staerke2 = 0.4
       If beleuchtungs_staerke = 70 Then beleuchtungs_staerke2 = 0.25

       _Scene.AmbientIntensity = beleuchtungs_staerke2 * 0.3

       _Scene.LightColor = Color.FromArgb(255, 255, 255)
       Render2()

   End Sub






   ''' <summary>
   ''' Handles the mouse events of the RenderPanel control.
   ''' </summary>
   Private Sub MouseInput(Data As MouseProvider.MouseData)

       Select Case Data.MouseEvent

           Case MouseProvider.MouseEvents.LeftClick
               If knoten_modus = 1 Then
                   ' Knoten suchen
                   _SelectedVertex = FindVertex(_MouseProvider.Data.Position.X, _MouseProvider.Data.Position.Y)
                   ' Falls gefunden Hilfsfenster aktualisieren
                   If _SelectedVertex > 0 Then
                       Call knoten_modus_ausgabe()
                       ' messen
                       If messpunkte_erstellen = 1 Then
                           If iface2 > 0 And iface2 <> iface_alt Then
                               If neck_mess = 1 Then
                                   messpunkte(1) = iface2
                               Else
                                   messpunkte(2) = iface2
                               End If
                               messen.Close()
                               messen.Show()
                               iface_alt = iface2
                           End If
                       End If
                   End If

               ElseIf flaechen_modus = 1 Then

                   ' Triangle-Modus
                   _SelectedFacet = FindFacet(_MouseProvider.Data.Position.X, _MouseProvider.Data.Position.Y)
                   If _SelectedFacet > 0 Then
                       ToolStripStatusLabel1.Text = "Triangle " & _SelectedFacet
                       'flächenmodus für baugruppe erzeugen
                       If aktion = 5 Then ibe(_SelectedFacet) = 1
                   End If


                   ' Baugruppen-Modus
               ElseIf eg_modus = 1 Then
                   ' Fläche suchen
                   _SelectedFacet = FindFacet(_MouseProvider.Data.Position.X, _MouseProvider.Data.Position.Y)
                   ' Falls gefunden Hilfsfenster aktualisieren
                   If _SelectedFacet > 0 Then
                       ngr = kfl(_SelectedFacet, 10)
                       eg_ngr = le(ngr)
                       If eg_ngr > 0 Then
                           If edge_modus_an = 0 Then
                               ToolStripStatusLabel1.Text = "Part " & Str(eg_ngr)
                           Else
                               ToolStripStatusLabel1.Text = "Edge " & Str(eg_ngr)
                           End If

                           'weiter siehe mouseinput und geometriedata
                           eg.TextBox1.Text = Str(eg_ngr)
                       End If
                   End If

                   ' jetzt kann fläche abgefragt werden und pan ist aus
                   pan_wieder_einschalten = 1

                   Me.Render2()
               End If



           Case MouseProvider.MouseEvents.LeftDown

               ' Rechteck aufspannen
               If rechteck_aufziehen = 1 Then
                   startx = _MouseProvider.Data.Position.X
                   starty = _MouseProvider.Data.Position.Y
                   rechteck_aufziehen = 2
                   'weiter in RenderPanel_MouseMove

               End If

               If rechteck_aufziehen = 0 Then _Scene.RotateByMouseStart(Data.Position)


           Case MouseProvider.MouseEvents.RightDown
               _Scene.PanByMouseStart(Data.Position)
               RenderPanel.Cursor = Cursors.SizeAll

               ' damit pan und flächen-abfrage mit rechter maustaste gleichzeitig geht
               If pan_wieder_einschalten = 1 Then
                   ' Baugruppen erzeugen abbrechen wenn rechte Maustaste
                   If aktion = 5 Then
                       eg_modus = 0
                       knoten_modus = 0
                       flaechen_modus = 0
                       RibbonCheckBox7.Checked = False
                       RibbonCheckBox8.Checked = False
                       RibbonCheckBox9.Checked = False
                       Dim i, j As Integer
                       j = 0
                       For i = 1 To nel
                           If ibe(i) = 1 Then le(i) = ngrup : j = j + 1
                           ibe(i) = 0
                       Next
                       RibbonPanel4.Text = "Neue oder alte Baugruppe " + Str(ngr_neu) + " mit " & Str(j) + " neuen Triangles wurde erzeugt"
                       aktion = 0
                       If ngr_neu > ngrup Then ngrup = ngr_neu
                       'neue baugruppe erzeugen
                       For i = 1 To 6
                           in5(ngr_neu, i) = in5(1, i)
                       Next
                       Dim i11, i1, i2, i3 As Integer
                       i11 = in5(ngr_neu, 6)
                       i1 = Int(i11 / 65536)
                       i2 = Int((i11 - (65536 * i1)) / 256)
                       i3 = Int(i11 - (65536 * i1 + 256 * i2))
                       ' sonst geht die farbe nicht in geometriedata
                       in5(ngr_neu, 6) = RGB(i1, i2, i3)
                       in5(ngr_neu, 7) = i1
                       in5(ngr_neu, 8) = i2
                       in5(ngr_neu, 9) = i3
                       eg.Close()
                       eg.Show()
                   Else
                       Dim k1, k2, k3 As Integer
                       Dim aw, x, y, z, xxp(3), yyp(3), zzp(3), a1, a2, a3, b1, b2, b3 As Single
                       aw = 0
                       For i = 1 To nel
                           If le(i) = eg_ngr Then
                               k1 = in7(i, 1)
                               k2 = in7(i, 2)
                               k3 = in7(i, 3)
                               xxp(1) = din8(k1, 1)
                               yyp(1) = din8(k1, 2)
                               zzp(1) = din8(k1, 3)

                               xxp(2) = din8(k2, 1)
                               yyp(2) = din8(k2, 2)
                               zzp(2) = din8(k2, 3)

                               xxp(3) = din8(k3, 1)
                               yyp(3) = din8(k3, 2)
                               zzp(3) = din8(k3, 3)

                               a1 = xxp(1) - xxp(3)
                               a2 = yyp(1) - yyp(3)
                               a3 = zzp(1) - zzp(3)

                               b1 = xxp(1) - xxp(2)
                               b2 = yyp(1) - yyp(2)
                               b3 = zzp(1) - zzp(2)

                               x = (a2 * b3) - (a3 * b2)
                               y = (a3 * b1) - (a1 * b3)
                               z = (a1 * b2) - (a2 * b1)

                               aw = aw + Math.Sqrt(x * x + y * y + z * z) * 0.5
                           End If
                       Next i


                       If edge_modus_an = 0 Then MsgBox("Baugruppe-Umfang " & eg_ngr & " hat eine Fläche von " & aw & " mm²")
                       If edge_modus_an = 1 Then MsgBox("Kante " & eg_ngr & " hat eine Fläche von " & aw & " mm²")
                       ' pan wieder einschalten
                       pan_wieder_einschalten = 0
                   End If
               End If



           Case MouseProvider.MouseEvents.LeftDrag
               If rechteck_aufziehen = 0 Then _Scene.RotateByMouseDrag(Data.Position) : Me.Render()


           Case MouseProvider.MouseEvents.RightDrag
               _Scene.PanByMouseDrag(Data.Position)
               Me.Render()

           Case MouseProvider.MouseEvents.Wheel
               '_Scene.ZoomByMouseWheel(Data.WheelDelta, 0.01)

               '_Scene.ZoomByMouseWheel(Data.WheelDelta, 0.05)


               If Data.WheelDelta < 0 Then
                   xmaxver = xmaxver - xmaxver * 0.01
               Else
                   xmaxver = xmaxver + xmaxver * 0.01
               End If



               Me.Render2()

           Case MouseProvider.MouseEvents.LeftUp
               _Scene.RotateByMouseEnd()
               Call vorige_ansicht_sichern()

               Call masspfeil_anzeigen()

               If rechteck_aufziehen = 2 Then
                   ToolStripStatusLabel1.Text = "Info"
                   Dim rect As New Rectangle(startx, starty, _MouseProvider.Data.Position.X - startx, _MouseProvider.Data.Position.Y - starty)
                   Dim g As Graphics = RenderPanel.CreateGraphics()
                   Dim pen As New Pen(Color.Blue, 1)
                   g.DrawRectangle(pen, rect)

                   xmin_reck = startx
                   xmax_reck = _MouseProvider.Data.Position.X
                   ymin_reck = starty
                   ymax_reck = _MouseProvider.Data.Position.Y

                   'nur für zoomen
                   If aktion <> 6 Then rechteck_aufziehen = 10

                   Call ibe_erstellen()
                   aktion = 0

               End If


           Case MouseProvider.MouseEvents.RightUp
               _Scene.PanByMouseEnd()
               RenderPanel.Cursor = Cursors.Default


           Case MouseProvider.MouseEvents.Move

               'automatische Einladung wenn stl.txt
               If m8_einladen = 2 Then
                   m8_einladen = 0
                   wert = 1
                   wert_2 = 1
                   datei_name = stl_txt
                   Call stl_importieren()
                   m8_einladen = 0
                   wert_2 = 1
                   Call einladen()
                   ' gewünschte Ansicht einstellen
                   ' Daten kann man in stl.mup im Datenblock $ZOOM_DX11_ ablesen
                   gedrehte_ansicht(5) = 0.740983
                   gedrehte_ansicht(6) = 0.4832317
                   gedrehte_ansicht(7) = 0.2627775
                   gedrehte_ansicht(8) = 0.3852005

               End If

               If wert_m8 = 5 Then
                   wert_m8 = 0
                   Call hauptansicht_wiederherstellen()
               End If

       End Select


   End Sub


   Sub masspfeil_anzeigen()

       Dim viewProj As Matrix
       viewProj = _Scene.ViewProjection

       Dim v1 As Vector3
       Dim v2 As Vector3
       Dim p0, p1 As Point

       Dim a1, a2, a3 As Single

       Dim nk1, nk2 As Integer


       nk1 = messpunkte(1)
       nk2 = messpunkte(2)

       If nk1 = 0 Or nk2 = 0 Then Exit Sub

       a1 = din8(nk1, 1)
       a2 = din8(nk1, 2)
       a3 = din8(nk1, 3)

       a1 = (a1 - xe_za) / xmaxver
       a2 = (a2 - ye_za) / xmaxver
       a3 = (a3 - ze_za) / xmaxver

       v1.X = a1
       v1.Y = a2
       v1.Z = a3

       v2 = Vector3.Project(v1, 0, 0, RenderPanel.Width, RenderPanel.Height, 0.0F, 1.0F, viewProj)

       p0.X = v2.X
       p0.Y = v2.Y

       a1 = din8(nk2, 1)
       a2 = din8(nk2, 2)
       a3 = din8(nk2, 3)

       a1 = (a1 - xe_za) / xmaxver
       a2 = (a2 - ye_za) / xmaxver
       a3 = (a3 - ze_za) / xmaxver

       v1.X = a1
       v1.Y = a2
       v1.Z = a3

       v2 = Vector3.Project(v1, 0, 0, RenderPanel.Width, RenderPanel.Height, 0.0F, 1.0F, viewProj)

       p1.X = v2.X
       p1.Y = v2.Y

       Dim value As Color
       value = Color.Black

       Dim g As Graphics = RenderPanel.CreateGraphics()
       Dim pen As New Pen(value, 3)
       g.DrawLine(pen, p0, p1)

       messpunkte(1) = 0
       messpunkte(2) = 0

   End Sub

   Sub vorige_ansicht_wiederherstellen()

       Dim savedTarget As Vector3
       Dim savedZoom As Single
       Dim savedRotation As Quaternion

       savedTarget.X = gedrehte_ansicht(1 + 14) 'gespeicherter Wert, typ. = CSng(Val( text ))
       savedTarget.Y = gedrehte_ansicht(2 + 14)
       savedTarget.Z = gedrehte_ansicht(3 + 14)


       savedZoom = gedrehte_ansicht(4 + 14)
       '  MsgBox("zoom " & gedrehte_ansicht(4))

       savedRotation.W = gedrehte_ansicht(5 + 14)
       savedRotation.X = gedrehte_ansicht(6 + 14)
       savedRotation.Y = gedrehte_ansicht(7 + 14)
       savedRotation.Z = gedrehte_ansicht(8 + 14)


       xmaxver = gedrehte_ansicht(10 + 14)
       xe_za = gedrehte_ansicht(11 + 14)
       ye_za = gedrehte_ansicht(12 + 14)
       ze_za = gedrehte_ansicht(13 + 14)

       _Scene.RestoreView(savedRotation, savedZoom, savedTarget)

       If gedrehte_ansicht(9 + 14) = 1 Then
           _Scene.RightHanded = False
       Else
           _Scene.RightHanded = True
       End If

       Render2()
   End Sub



   Sub vorige_ansicht_sichern()

       ' gedrehte Ansicht merken
       gedrehte_ansicht(1 + 14) = _Scene.Target.X      ' Verschiebung, typ.text = Str(_Scene.Target.X)
       gedrehte_ansicht(2 + 14) = _Scene.Target.Y
       gedrehte_ansicht(3 + 14) = _Scene.Target.Z

       gedrehte_ansicht(4 + 14) = _Scene.Zoom    '       Zoom

       gedrehte_ansicht(5 + 14) = _Scene.Rotation.W     'Drehung
       gedrehte_ansicht(6 + 14) = _Scene.Rotation.X
       gedrehte_ansicht(7 + 14) = _Scene.Rotation.Y
       gedrehte_ansicht(8 + 14) = _Scene.Rotation.Z

       ' _Scene.RightHanded=true
       gedrehte_ansicht(9 + 14) = 0
       If _Scene.RightHanded = False Then gedrehte_ansicht(9 + 14) = 1

       ' xmaxver
       gedrehte_ansicht(10 + 14) = xmaxver
       ' xe_z
       gedrehte_ansicht(11 + 14) = xe_za
       ' ya_z
       gedrehte_ansicht(12 + 14) = ye_za
       ' za_z
       gedrehte_ansicht(13 + 14) = ze_za
       ' dummy
       gedrehte_ansicht(14 + 14) = 0

       'render2()

   End Sub


   Sub ansicht_einstellen()

       ' ansicht sichern über linker mausklick

       Call vorige_ansicht_sichern()

       If data1(1, 1) = 3 Then _Scene.SetView(ViewPreset.Top)
       If data1(1, 1) = 4 Then _Scene.SetView(ViewPreset.Bottom)
       If data1(1, 1) = 5 Then _Scene.SetView(ViewPreset.Front)
       If data1(1, 1) = 6 Then _Scene.SetView(ViewPreset.Rear)
       If data1(1, 1) = 7 Then _Scene.SetView(ViewPreset.Left)
       If data1(1, 1) = 8 Then _Scene.SetView(ViewPreset.Right)

       If data1(1, 1) = 9 Then _Scene.RightHanded = True : _Scene.SetView(ViewPreset.IsoTopSO)
       If data1(1, 1) = 10 Then _Scene.RightHanded = False : _Scene.SetView(ViewPreset.IsoTopSW)
       If data1(1, 1) = 11 Then _Scene.RightHanded = True : _Scene.SetView(ViewPreset.IsoTopNO)
       If data1(1, 1) = 12 Then _Scene.RightHanded = False : _Scene.SetView(ViewPreset.IsoTopNW)



       Render2()

   End Sub


   ' vorige Ansicht
   Private Sub RibbonLabel14_Click(ByVal sender As Object, ByVal e As EventArgs) Handles RibbonLabel14.Click
       data1(1, 1) = 0
       'Call vorige_ansicht_wiederherstellen()
       Call hauptansicht_sichern()
   End Sub

   Private Sub Ribbonbutton4_Click(ByVal sender As Object, ByVal e As EventArgs) Handles RibbonButton4.Click
       data1(1, 1) = 0
       Call vorige_ansicht_wiederherstellen()
   End Sub


   ' Zoom
   Private Sub Ribbonbutton15_Click(ByVal sender As Object, ByVal e As EventArgs) Handles RibbonButton15.Click
       ToolStripStatusLabel1.Text = "Mit gedrückter linker Maustaste ein Rechteck über dem Modell aufpannen um diesen Modellbereich zu vergrößern!"
       rechteck_aufziehen = 1
   End Sub

   ' setting
   Private Sub Ribbonbutton22_Click(ByVal sender As Object, ByVal e As EventArgs) Handles RibbonButton22.Click
       Farben.Show()
       Render2()
   End Sub


   Sub gesamtansicht_view()

       Call gesamtansicht_module1()

       If in5(1, 3) >= 70 Then
           'entweder 3d
           gedrehte_ansicht(5) = -0.218
           gedrehte_ansicht(6) = -0.1329
           gedrehte_ansicht(7) = 0.519
           gedrehte_ansicht(8) = 0.815
           _Scene.RightHanded = True
           _Scene.SetView(ViewPreset.IsoTopSO)
           'oder 2d
       Else
           gedrehte_ansicht(5) = 0
           gedrehte_ansicht(6) = 0
           gedrehte_ansicht(7) = 1
           gedrehte_ansicht(8) = 0
           gedrehte_ansicht(9) = 1
           _Scene.RightHanded = False
           _Scene.SetView(ViewPreset.Front)
       End If

       Call hauptansicht_sichern()

   End Sub

   ' gesamtansicht-hauptansicht
   Private Sub RibbonLabel13_Click(ByVal sender As Object, ByVal e As EventArgs) Handles RibbonLabel13.Click
       Call gesamtansicht_view()
       '    Call vorige_ansicht_wiederherstellen()
   End Sub

   Private Sub Ribbonbutton23_Click(ByVal sender As Object, ByVal e As EventArgs) Handles RibbonButton23.Click
       Call hauptansicht_wiederherstellen()
   End Sub



   Sub hauptansicht_sichern()

       'MsgBox("hauptansicht sichern!")

       ' gedrehte Ansicht merken
       gedrehte_ansicht(1) = _Scene.Target.X      ' Verschiebung, typ.text = Str(_Scene.Target.X)
       gedrehte_ansicht(2) = _Scene.Target.Y
       gedrehte_ansicht(3) = _Scene.Target.Z

       gedrehte_ansicht(4) = _Scene.Zoom    '       Zoom

       gedrehte_ansicht(5) = _Scene.Rotation.W     'Drehung
       gedrehte_ansicht(6) = _Scene.Rotation.X
       gedrehte_ansicht(7) = _Scene.Rotation.Y
       gedrehte_ansicht(8) = _Scene.Rotation.Z

       ' _Scene.RightHanded=true
       gedrehte_ansicht(9) = 0
       If _Scene.RightHanded = False Then gedrehte_ansicht(9) = 1

       gedrehte_ansicht(11) = xe_za
       gedrehte_ansicht(12) = ye_za
       gedrehte_ansicht(13) = ze_za
       gedrehte_ansicht(10) = xmaxver
       Render2()

   End Sub



   Sub hauptansicht_wiederherstellen()

       Dim savedTarget As Vector3
       Dim savedZoom As Single
       Dim savedRotation As Quaternion

       savedTarget.X = gedrehte_ansicht(1) 'gespeicherter Wert, typ. = CSng(Val( text ))
       savedTarget.Y = gedrehte_ansicht(2)
       savedTarget.Z = gedrehte_ansicht(3)


       savedZoom = gedrehte_ansicht(4)
       '  MsgBox("zoom " & gedrehte_ansicht(4))
       If savedZoom = 0 Then savedZoom = 5

       savedRotation.W = gedrehte_ansicht(5)
       savedRotation.X = gedrehte_ansicht(6)
       savedRotation.Y = gedrehte_ansicht(7)
       savedRotation.Z = gedrehte_ansicht(8)

       xmaxver = gedrehte_ansicht(10)
       xe_za = gedrehte_ansicht(11)
       ye_za = gedrehte_ansicht(12)
       ze_za = gedrehte_ansicht(13)


       If gedrehte_ansicht(9) = 1 Then
           _Scene.RightHanded = False
       Else
           _Scene.RightHanded = True
       End If

       _Scene.RestoreView(savedRotation, savedZoom, savedTarget)


       Render2()

   End Sub




   ' von oben
   Private Sub RibbonLabel21_Click(ByVal sender As Object, ByVal e As EventArgs) Handles RibbonLabel21.Click
       data1(1, 1) = 3
       Call ansicht_einstellen()

   End Sub

   ' von unten
   Private Sub RibbonLabel22_Click(ByVal sender As Object, ByVal e As EventArgs) Handles RibbonLabel22.Click
       data1(1, 1) = 4
       Call ansicht_einstellen()
   End Sub

   ' von vorne
   Private Sub RibbonLabel23_Click(ByVal sender As Object, ByVal e As EventArgs) Handles RibbonLabel23.Click

       data1(1, 1) = 5
       Call ansicht_einstellen()

   End Sub


   ' von hinten
   Private Sub RibbonLabel24_Click(ByVal sender As Object, ByVal e As EventArgs) Handles RibbonLabel24.Click

       data1(1, 1) = 6
       Call ansicht_einstellen()
   End Sub

   ' von links
   Private Sub RibbonLabel25_Click(ByVal sender As Object, ByVal e As EventArgs) Handles RibbonLabel25.Click


       data1(1, 1) = 7
       Call ansicht_einstellen()

   End Sub

   ' von rechts
   Private Sub RibbonLabel26_Click(ByVal sender As Object, ByVal e As EventArgs) Handles RibbonLabel26.Click


       data1(1, 1) = 8
       Call ansicht_einstellen()

   End Sub


   ' Süd-Ost
   Private Sub RibbonLabel27_Click(ByVal sender As Object, ByVal e As EventArgs) Handles RibbonLabel27.Click


       data1(1, 1) = 9
       Call ansicht_einstellen()

   End Sub


   ' Süd-west
   Private Sub RibbonLabel28_Click(ByVal sender As Object, ByVal e As EventArgs) Handles RibbonLabel28.Click

       data1(1, 1) = 10
       Call ansicht_einstellen()

   End Sub

   ' nw
   Private Sub RibbonLabel29_Click(ByVal sender As Object, ByVal e As EventArgs) Handles RibbonLabel29.Click


       data1(1, 1) = 11
       Call ansicht_einstellen()

   End Sub


   ' no
   Private Sub RibbonLabel30_Click(ByVal sender As Object, ByVal e As EventArgs) Handles RibbonLabel30.Click

       data1(1, 1) = 12
       Call ansicht_einstellen()

   End Sub


   ' Right-Handed
   Private Sub RibbonLabel31_Click(ByVal sender As Object, ByVal e As EventArgs) Handles RibbonLabel31.Click

       _Scene.RightHanded = True

       Render2()

   End Sub

   ' Left-Handed
   Private Sub RibbonLabel32_Click(ByVal sender As Object, ByVal e As EventArgs) Handles RibbonLabel32.Click

       _Scene.RightHanded = False

       Render2()

   End Sub

   Sub means_beenden()
       _DX11Device.Dispose()
       Call netzwerk_sichern()
       Application.Exit()
       End
   End Sub


   ' koordinaten
   Private Sub Ribbonlabel19_Click(ByVal sender As Object, ByVal e As EventArgs) Handles RibbonLabel19.Click
       dbCOOR.Show()
       Render()
   End Sub

   ' ekn
   Private Sub Ribbonlabel36_Click(ByVal sender As Object, ByVal e As EventArgs) Handles RibbonLabel36.Click
       dbekn.Show()
       Render()
   End Sub

   ' koordinaten-faktor
   Private Sub Ribbonlabel20_Click(ByVal sender As Object, ByVal e As EventArgs) Handles RibbonLabel20.Click
       faktor.Show()
       Render()
   End Sub

   ' baugruppen
   Private Sub Ribbonbutton13_Click(ByVal sender As Object, ByVal e As EventArgs) Handles RibbonButton13.Click
       eg.Show()
   End Sub


   ' importieren
   Private Sub Ribbonbutton6_Click(ByVal sender As Object, ByVal e As EventArgs) Handles RibbonButton6.Click
       step2stl_umwandeln = 2
       import.Show()
   End Sub



   ' Modell-Infos
   Private Sub RibbonLabel37_Click(ByVal sender As Object, ByVal e As EventArgs) Handles RibbonLabel37.Click
       modell_infos.Show()
   End Sub


   ' Abmessungen
   Private Sub RibbonLabel65_Click(ByVal sender As Object, ByVal e As EventArgs) Handles RibbonLabel65.Click
       abmessungen.Show()
   End Sub

   ' messen
   Private Sub Ribbonbutton21_Click(ByVal sender As Object, ByVal e As EventArgs) Handles RibbonButton21.Click
       knoten_modus = 1
       RibbonCheckBox8.Checked = True
       RibbonCheckBox9.Checked = False
       RibbonCheckBox7.Checked = False
       flaechen_modus = 0
       eg_modus = 0

       messpunkte_erstellen = 1
       messen.Show()
       Render2()

   End Sub


   Sub original_einstellen()
       Call wieder_oringal_koordinaten()

       ' anzahl der drehungen wieder auf nullsetzen
       For i = 1 To anzahl_animationen
           zzz_drehen(i) = 0
       Next

       Timer2.Enabled = False
       Timer3.Enabled = False
       Timer4.Enabled = False
       Timer5.Enabled = False
       Render2()
   End Sub

   ' quit
   Private Sub RibbonLabel75_Click(ByVal sender As Object, ByVal e As EventArgs) Handles RibbonLabel75.Click
       Call original_einstellen()
   End Sub


   ' animationen starten
   Private Sub RibbonLabel76_Click(ByVal sender As Object, ByVal e As EventArgs) Handles RibbonLabel76.Click

       ' jetzt erst alle drehpunkte und teilbewegungen mit ibe_ani berechnen
       Call animation_drehen.starten_drehpunkte_undteilbewegungen_berechnen()

   End Sub


   ' animationen auswahl-menü zeigen
   Private Sub RibbonLabel77_Click(ByVal sender As Object, ByVal e As EventArgs) Handles RibbonLabel77.Click
       animation_controller.Show()
   End Sub

   ' pause
   Private Sub RibbonLabel78_Click(ByVal sender As Object, ByVal e As EventArgs)
       Timer5.Enabled = False
   End Sub


   ' animationen eingabe
   Private Sub RibbonLabel12_Click(ByVal sender As Object, ByVal e As EventArgs) Handles RibbonLabel12.Click
       animation_drehen.Show()
   End Sub


   ' animationen einladen
   Private Sub RibbonLabel73_Click(ByVal sender As Object, ByVal e As EventArgs) Handles RibbonLabel73.Click
       animation_controller.animation_einladen()
       'counter.Show()
   End Sub

   ' animationen sichern
   Private Sub RibbonLabel74_Click(ByVal sender As Object, ByVal e As EventArgs) Handles RibbonLabel74.Click
       animation_controller.animation_sichern()
   End Sub


   Private Sub Timer5_Tick_1(sender As Object, e As EventArgs) Handles Timer5.Tick
       Dim zzz As Single
       Dim co, si As Single
       Dim ii As Integer
       Dim schrittweite As Single
       Dim bewegungsrichtung As Integer

       timer5_laufzeit = timer5_laufzeit + 1


       For ii = 1 To anzahl_animationen

           'wartezeit bis animation startet
           If animations_felder(15, ii) <> 0 Then
               If timer5_laufzeit < animations_felder(15, ii) Then GoTo nextii
           End If


           ' translation
           If animations_felder(3, ii) = 2 Then

               Dim start_weg As Integer = Val(animations_felder(9, ii))
               Dim end_weg As Integer = Val(animations_felder(10, ii))

               schrittweite = Val(animations_felder(6, ii))
               bewegungsrichtung = Val(animations_felder(4, ii))

               ' in x-richtung
               If bewegungsrichtung = 1 Then
                   '    MsgBox(xzent_weg & " " & end_weg & " " & schrittweite)

                   If xzent_weg > 0 Then
                       If xzent_weg > end_weg Then GoTo nextii
                   End If

                   If xzent_weg < 0 Then
                       If xzent_weg < end_weg Then GoTo nextii
                   End If

                   For i = 1 To neck
                       If ibe_ani(i, ii) > 0 Then din8(i, 1) = din8(i, 1) + schrittweite
                   Next
                   ' drehpunkt von rotorblatt anpassen an neue koordinaten
                   xzent_weg = xzent_weg + schrittweite
                   schrittweite_x_translation = xzent_weg
               End If

               ' in y-richtung
               If bewegungsrichtung = 2 Then

                   If yzent_weg > 0 Then
                       If yzent_weg > end_weg Then GoTo nextii
                   End If

                   If yzent_weg < 0 Then
                       If yzent_weg < end_weg Then GoTo nextii
                   End If


                   For i = 1 To neck
                       If ibe_ani(i, ii) > 0 Then din8(i, 2) = din8(i, 2) + schrittweite
                   Next
                   yzent_weg = yzent_weg + schrittweite
                   schrittweite_y_translation = yzent_weg
               End If

               ' in z-richtung
               If bewegungsrichtung = 3 Then

                   If zzent_weg > 0 Then
                       If zzent_weg > end_weg Then GoTo nextii
                   End If

                   If zzent_weg < 0 Then
                       If zzent_weg < end_weg Then GoTo nextii
                   End If

                   For i = 1 To neck
                       If ibe_ani(i, ii) > 0 Then din8(i, 3) = din8(i, 3) + schrittweite
                   Next
                   zzent_weg = zzent_weg + schrittweite
                   schrittweite_z_translation = zzent_weg
               End If


           End If


           If animations_felder(3, ii) = 1 Then
               ' winkel-erhöung für drehung
               zzz = Val(animations_felder(6, ii))

               ' gesamtumdrehung = 360/zzz
               zzz_drehen(ii) = zzz_drehen(ii) + zzz

               'dim startwinkel und endwinkel
               Dim start_winkel As Integer = Val(animations_felder(9, ii))
               Dim end_winkel As Integer = Val(animations_felder(10, ii))

               If zzz_drehen(ii) < 0 Then
                   If zzz_drehen(ii) < -end_winkel Then GoTo nextii
                   If zzz_drehen(ii) > -start_winkel Then GoTo nextii

               Else
                   If zzz_drehen(ii) > end_winkel Then GoTo nextii
                   If zzz_drehen(ii) < start_winkel Then GoTo nextii
               End If

               Label2.Text = Str(zzz_drehen(1))

               zzz = zzz * 3.14159265 / 180

               co = Math.Cos(zzz)
               si = Math.Sin(zzz)

               xzent = drehpunkte(1, 1, ii) + schrittweite_x_translation
               yzent = drehpunkte(1, 2, ii) + schrittweite_y_translation
               zzent = drehpunkte(1, 3, ii) + schrittweite_z_translation


               ' drehung um die x-achse
               If animations_felder(4, ii) = 1 Then Call xyzdr(2, 3, zzz, yzent, zzent, ii)

                   ' drehung um die y-achse
                   If animations_felder(4, ii) = 2 Then Call xyzdr(1, 3, zzz, xzent, zzent, ii)

                   ' drehung um die z-achse
                   If animations_felder(4, ii) = 3 Then Call xyzdr(1, 2, zzz, xzent, yzent, ii)

               End If

nextii:
       Next ii

       eg_modus = 0

       Render2()

   End Sub



   Sub xyzdr(ByVal k1, ByVal k2, ByVal XYZ, ByVal XZ1, ByVal XZ2, ByVal ii)
       Dim co, si As Single
       Dim i As Integer
       Dim xvek, yvek As Single

       co = Math.Cos(XYZ)
       si = Math.Sin(XYZ)

       For i = 1 To neck
           ' nur knoten der eingeblendeten baugruppe
           If ibe_ani(i, ii) > 0 Then
               xvek = din8(i, k1) - XZ1
               yvek = din8(i, k2) - XZ2
               din8(i, k1) = co * xvek - si * yvek + XZ1
               din8(i, k2) = si * xvek + co * yvek + XZ2
           End If

       Next i

   End Sub


   Private Sub RenderPanel_MouseMove(sender As Object, e As MouseEventArgs) Handles RenderPanel.MouseMove

       If rechteck_aufziehen = 2 Then
           Me.Render()
           Dim rect As New Rectangle(startx, starty, e.X - startx, e.Y - starty)
           Dim g As Graphics = RenderPanel.CreateGraphics()
           Dim pen As New Pen(Color.Blue, 1)
           g.DrawRectangle(pen, rect)
       End If


   End Sub

   Private Sub Timer2_Tick(sender As Object, e As EventArgs) Handles Timer2.Tick

   End Sub




End Class

 
 
 
 
 
 
Zurück zum Seiteninhalt | Zurück zum Hauptmenü