Option Explicit
Dim polygonanzahl As Integer
Dim oLines(1 To 20) As SketchLine

Private Sub closeform_click()
Polygonerstellung.hide
End Sub


Public Sub insertpoint_Click()

Dim polygonzähler As Integer
Dim constpolygon As Integer
Dim xwert As Single
Dim ywert As Single
Dim xwert2 As Single
Dim ywert2 As Single
Dim xwert3 As Single
Dim ywert3 As Single

Dim i As Integer

'constpolygon = polygons.Value
If xbox.Value = "" Or ybox.Value = "" Then
MsgBox ("Bitte Koordinaten eingeben")
Exit Sub
End If

xwert = xbox.Value
xwert = ybox.Value

'Feststellen ob eine Skizze aktiv ist
If Not TypeOf ThisApplication.ActiveEditObject Is PlanarSketch Then
MsgBox "Eine Skizze muss aktiv sein"
Exit Sub
End If

'Einen Bezug zur aktiven Skizze herstellen
Dim oSketch As PlanarSketch
Set oSketch = ThisApplication.ActiveEditObject

'Einen Bezug zur temporären Geometriesammlung herstellen
Dim oTransGeom As TransientGeometry
Set oTransGeom = ThisApplication.TransientGeometry

'Erstellen einer neuen Durchführung zum Unterbrechen der Konstruktion der 3 Linien mit einem einzigen UNDO
Dim oTrans As Transaction
Set oTrans = ThisApplication.TransactionManager.StartTransaction( _
ThisApplication.ActiveDocument, _
"Erstelle Dreieck Beispiel")

'Erstellen der ersten Linie des Dreiecks. Dazu werden zwei temporäre Eingabepunkte
'zur Definition der Linienenden verwendet. Da ein temporärer Punkt gleichzeitig
'auch ein Skizzierpunkt ist werden Verbindungsstellen automatisch verbunden

Select Case oSketch.SketchLines.Count
Case Is = 0
Set oLines(1) = oSketch.SketchLines.AddByTwoPoints(oTransGeom.CreatePoint2d(0, 0), _
oTransGeom.CreatePoint2d(xwert, ywert))
xbox.Cut
ybox.Cut
Exit Sub


Case Is = 1
Set oLines(2) = oSketch.SketchLines.AddByTwoPoints(oLines(1).EndSketchPoint, _
oTransGeom.CreatePoint2d(xwert, ywert))
xbox = ""
ybox = ""
Exit Sub


Case Is = 2
If polygonanzahl = 3 Then GoTo schliessen Else
GoTo weiter

schliessen:

Set oLines(3) = oSketch.SketchLines.AddByTwoPoints(oLines(2).EndSketchPoint, _
oLines(1).StartSketchPoint)
xbox.Cut
ybox.Cut
Exit Sub

Exit Sub

weiter:

Set oLines(3) = oSketch.SketchLines.AddByTwoPoints(oLines(2).EndSketchPoint, _
oTransGeom.CreatePoint2d(xwert, ywert))
xbox.Cut
ybox.Cut
Exit Sub

fornextschleife:
End Select

For i = 4 To polygonanzahl

'Befestige den Linienanfang der 2. Linie am Ende der alten Linie durch Vergabe
'der gleichen Koordinaten für beide Punkte

Set oLines(i) = oSketch.SketchLines.AddByTwoPoints(oLines(i - 1).EndSketchPoint, _
oTransGeom.CreatePoint2d(xwert, ywert))

i = i + 1
Next
'Erstellung der 3.Linie und Verbindung des Endes mit dem Anfang der 1.Linie
'Daraus entsteht dann ein Dreieck

'Ende der Durchführung
ThisApplication.TransactionManager.EndTransaction



End Sub

Sub Polygonerstellung_initialize()
xwert = ""
ywert = ""
polygons = ""
End Sub