Option Explicit
'Global appWorld, w As Excel.Application
'Global wbWorld As Excel.Workbook
'Global w As Excel.Worksheet
Global ActDr As IMSIGX.Drawing
Dim app As Application
Dim vi, vvi As View
Dim xclick As Double
Dim yclick As Double
Dim xworld As Double
Dim yworld As Double
Dim zworld As Double
Dim xclick2 As Double
Dim yclick2 As Double
Dim xworld2 As Double
Dim yworld2 As Double
Dim zworld2 As Double
Dim x1, y1, x2, y2, x3, y3, x4, y4 As Double
Dim gr, linie, gr1, gr2 As Graphic
Dim PropCount As Long
Dim ItemProp, pos1 As Long
Dim NameProp, WertProp, LangerWert, DritteStelle, Info, Wertbis2 As String
Dim ValueProp As Variant
Dim i, j, k, k1, n As Integer
Dim ddl, winkel, winkel1, grad, pi As Double
Dim Ver As Vertex
Dim Station As Long
Dim Länge, dl, Abstand, gesL, jj, lstrich   As Double
Dim ExcelSheet As Object
Dim richt As String
Dim GrSel As Graphic

Sub main()
Set app = IMSIGX.Application
Set vi = app.ActiveDrawing.ActiveView
Set vvi = app.ActiveDrawing.ActiveView
    Set ActDr = ActiveDrawing

' Spline oder Bezier  anwählen
' funktioniert bei 2D-Spline und Polyline mit Kreiselementen
' funzt besser bei 2D-Spline
' funzt nicht bei Polyline ohne Kreiselemente
' Fehler bei senkrechten elementen
' erzeugt 1m Linien rechtwinklig zum Spline
' diese dann mit Multiextend auf die BöschUK verlängern
' dann "jede zweite Halbieren"

' bei spline ggfs splinesegmente verkleinern

' Achtung: bei Bezier-kurven erst Segmente auf >60 einstellen

lstrich = 2  'länge der Querstriche
MsgBox "funktioniert gut mit 2D-Spline (schlecht mit Polyline mit geraden und bögen - garnicht mit geknickten Polyline)"
richt = "L"
'richt = InputBox("Richtung Links=L Rechts=R ", "Richtung Links=L Rechts=R", richt)
Abstand = 0.5
Abstand = InputBox("Abstand der Böschungslinien ", , Abstand)
'Abstand = Val(Abstand)

i = 0: j = 0: Länge = 0: WertProp = "": k = 1: k1 = 0

If ActiveDrawing.Selection.Item(0).Type = "TCW30CURVE" Then ' spline klappt am besten
    
       'abstand so einstellen, daß sich insgesamt eine ungerade Anzahl Linien ergibt
       gesL = ActiveDrawing.Selection.Item(0).Graphics(1).Properties.Item("M_Length").Value
       n = Int(gesL / Abstand)
       ' If Int(n / 2) = n / 2 Then n = n + 1  ' sorgt für gerade Feldzahl
        'Abstand = gesL * 0.99999999 / (n + 1)

For i = 0 To ActiveDrawing.Selection.Item(0).Graphics(1).Vertices.Count - 1
x1 = ActiveDrawing.Selection.Item(0).Graphics(1).Vertices(i).X + ActiveDrawing.Selection.Item(0).UCS.GetEntry(0, 3)
y1 = ActiveDrawing.Selection.Item(0).Graphics(1).Vertices(i).Y + ActiveDrawing.Selection.Item(0).UCS.GetEntry(1, 3)

x2 = ActiveDrawing.Selection.Item(0).Graphics(1).Vertices(i + 1).X + ActiveDrawing.Selection.Item(0).UCS.GetEntry(0, 3)
y2 = ActiveDrawing.Selection.Item(0).Graphics(1).Vertices(i + 1).Y + ActiveDrawing.Selection.Item(0).UCS.GetEntry(1, 3)

pi = 4 * Atn(1)
winkel = Atn((y2 - y1) / (x2 - x1))
dl = Sqr((y2 - y1) ^ 2 + (x2 - x1) ^ 2)

'w.Cells(I + 2, 2) = x1
'w.Cells(I + 2, 3) = y1
'w.Cells(I + 2, 4) = winkel
'w.Cells(I + 2, 5) = winkel * 180 / pi
If Länge = 0 Then     ' nur bis zum ersten Strich
x4 = x1: y4 = y1
If richt = "l" Or richt = "L" Then winkel1 = winkel + pi / 2
If richt = "r" Or richt = "R" Then winkel1 = winkel + 3 * pi / 2

If winkel1 >= 0 And winkel1 < (pi) Then x3 = x4 + Cos(winkel1) * lstrich: y3 = y4 + Sin(winkel1) * lstrich: linie = ActDr.Graphics.AddLineSingle(x4, y4, 0, x3, y3, 0)
If winkel1 >= pi And winkel1 < (2 * pi) Then x3 = x4 + Cos(winkel1) * lstrich: y3 = y4 + Sin(winkel1) * lstrich: linie = ActDr.Graphics.AddLineSingle(x4, y4, 0, x3, y3, 0)
Else
End If

Länge = Länge + dl
If Länge >= k * Abstand Then
ddl = Länge - k * Abstand       ' Zwischenpunkt bei geraden Abständen ermitteln
x4 = x1 + (dl - ddl) / dl * (x2 - x1): y4 = y1 + (dl - ddl) / dl * (y2 - y1) '
If richt = "l" Or richt = "L" Then winkel1 = winkel + pi / 2
If richt = "r" Or richt = "R" Then winkel1 = winkel + 3 * pi / 2

If winkel1 >= 0 And winkel1 < (pi) Then x3 = x4 + Cos(winkel1) * lstrich: y3 = y4 + Sin(winkel1) * lstrich: linie = ActDr.Graphics.AddLineSingle(x4, y4, 0, x3, y3, 0)
If winkel1 >= pi And winkel1 < (2 * pi) Then x3 = x4 + Cos(winkel1) * lstrich: y3 = y4 + Sin(winkel1) * lstrich: linie = ActDr.Graphics.AddLineSingle(x4, y4, 0, x3, y3, 0)

'Debug.Print k, Länge
k = k + 1
Else
End If

On Error Resume Next
Next i
'Debug.Print k, Länge
Else
End If


If ActiveDrawing.Selection.Item(0).Type = "TCW50Polyline" Then  ' polyline mit Bögen drin
For i = 0 To ActiveDrawing.Selection.Item(0).Graphics(0).Vertices.Count - 1
x1 = ActiveDrawing.Selection.Item(0).Graphics(0).Vertices(i).X + ActiveDrawing.Selection.Item(0).UCS.GetEntry(0, 3)
y1 = ActiveDrawing.Selection.Item(0).Graphics(0).Vertices(i).Y + ActiveDrawing.Selection.Item(0).UCS.GetEntry(1, 3)

x2 = ActiveDrawing.Selection.Item(0).Graphics(0).Vertices(i + 1).X + ActiveDrawing.Selection.Item(0).UCS.GetEntry(0, 3)
y2 = ActiveDrawing.Selection.Item(0).Graphics(0).Vertices(i + 1).Y + ActiveDrawing.Selection.Item(0).UCS.GetEntry(1, 3)
pi = 4 * Atn(1)
winkel = Atn((y2 - y1) / (x2 - x1))
dl = Sqr((y2 - y1) ^ 2 + (x2 - x1) ^ 2)

'w.Cells(I + 2, 2) = x1
'w.Cells(I + 2, 3) = y1
'w.Cells(I + 2, 4) = winkel
'w.Cells(I + 2, 5) = winkel * 180 / pi

If dl > Abstand Then  ' Gerade so lang, daß mehrere Böschlinien zu zeichnen sind
k1 = 0
For jj = Länge To Länge + dl Step Abstand

If Länge > 0 Then ddl = Länge - (k - 1) * Abstand - k1 * Abstand ' Zwischenpunkt bei geraden Abständen ermitteln
If Länge = 0 Then ddl = k1 * Abstand
x4 = x1 + (ddl + k1 * Abstand) / dl * (x2 - x1): y4 = y1 + (ddl + k1 * Abstand) / dl * (y2 - y1) '
If richt = "l" Or richt = "L" Then winkel1 = winkel + pi / 2
If richt = "r" Or richt = "R" Then winkel1 = winkel + 3 * pi / 2

If winkel1 >= 0 And winkel1 < (pi) Then x3 = x4 + Cos(winkel1) * lstrich: y3 = y4 + Sin(winkel1) * lstrich: linie = ActDr.Graphics.AddLineSingle(x4, y4, 0, x3, y3, 0)
If winkel1 >= pi And winkel1 < (2 * pi) Then x3 = x4 + Cos(winkel1) * lstrich: y3 = y4 + Sin(winkel1) * lstrich: linie = ActDr.Graphics.AddLineSingle(x4, y4, 0, x3, y3, 0)
k1 = k1 + 1
Länge = Länge + Abstand
Next jj

k = k + k1
Else
Länge = Länge + dl
End If

If Länge >= k * Abstand Then
ddl = Länge - k * Abstand       ' Zwischenpunkt bei geraden Abständen ermitteln
x4 = x1 + (dl - ddl) / dl * (x2 - x1): y4 = y1 + (dl - ddl) / dl * (y2 - y1) '
If richt = "l" Or richt = "L" Then winkel1 = winkel + pi / 2
If richt = "r" Or richt = "R" Then winkel1 = winkel + 3 * pi / 2

If winkel1 >= 0 And winkel1 < (pi) Then x3 = x4 + Cos(winkel1) * lstrich: y3 = y4 + Sin(winkel1) * lstrich: linie = ActDr.Graphics.AddLineSingle(x4, y4, 0, x3, y3, 0)
If winkel1 >= pi And winkel1 < (2 * pi) Then x3 = x4 + Cos(winkel1) * lstrich: y3 = y4 + Sin(winkel1) * lstrich: linie = ActDr.Graphics.AddLineSingle(x4, y4, 0, x3, y3, 0)

'Debug.Print k, Länge
k = k + 1
Else
End If

On Error Resume Next
Next i
'Debug.Print k, Länge
Else
End If

'Set linie = ActiveDrawing.Graphics.Add.Graphics.AddLineSingle(xworld, yworld, 0, xworld2, yworld2, 0)


'gr1.Delete



'TCWConstructionHorizontalLine
If ActiveDrawing.Selection.Item(0).Type = "GRAPHIC" Then  ' Polylinie aus Praxl
    
       'abstand so einstellen, daß sich insgesamt eine ungerade Anzahl Linien ergibt
       gesL = ActiveDrawing.Selection.Item(0).Properties.Item("M_Length").Value
       n = Int(gesL / Abstand)
       If Int(n / 2) = n / 2 Then n = n + 1
        'Abstand = gesL * 0.99999 / (n + 1)

For i = 0 To ActiveDrawing.Selection.Item(0).Vertices.Count - 1
x1 = ActiveDrawing.Selection.Item(0).Vertices(i).X + ActiveDrawing.Selection.Item(0).UCS.GetEntry(0, 3)
y1 = ActiveDrawing.Selection.Item(0).Vertices(i).Y + ActiveDrawing.Selection.Item(0).UCS.GetEntry(1, 3)

x2 = ActiveDrawing.Selection.Item(0).Vertices(i + 1).X + ActiveDrawing.Selection.Item(0).UCS.GetEntry(0, 3)
y2 = ActiveDrawing.Selection.Item(0).Vertices(i + 1).Y + ActiveDrawing.Selection.Item(0).UCS.GetEntry(1, 3)

pi = 4 * Atn(1)
winkel = Atn((y2 - y1) / (x2 - x1))
dl = Sqr((y2 - y1) ^ 2 + (x2 - x1) ^ 2)

'w.Cells(I + 2, 2) = x1
'w.Cells(I + 2, 3) = y1
'w.Cells(I + 2, 4) = winkel
'w.Cells(I + 2, 5) = winkel * 180 / pi
If Länge = 0 Then
x4 = x1: y4 = y1
If richt = "l" Or richt = "L" Then winkel1 = winkel + pi / 2
If richt = "r" Or richt = "R" Then winkel1 = winkel + 3 * pi / 2

If winkel1 >= 0 And winkel1 < (pi) Then x3 = x4 + Cos(winkel1) * lstrich: y3 = y4 + Sin(winkel1) * lstrich: linie = ActDr.Graphics.AddLineSingle(x4, y4, 0, x3, y3, 0)
If winkel1 >= pi And winkel1 < (2 * pi) Then x3 = x4 + Cos(winkel1) * lstrich: y3 = y4 + Sin(winkel1) * lstrich: linie = ActDr.Graphics.AddLineSingle(x4, y4, 0, x3, y3, 0)
Else
End If

If dl > Abstand Then  ' Gerade so lang, daß mehrere Böschlinien zu zeichnen sind
k1 = 0
For jj = Länge To Länge + dl Step Abstand

If Länge > 0 Then ddl = Länge - (k - 1) * Abstand - k1 * Abstand ' Zwischenpunkt bei geraden Abständen ermitteln
If Länge = 0 Then ddl = k1 * Abstand
x4 = x1 + (ddl + k1 * Abstand) / dl * (x2 - x1): y4 = y1 + (ddl + k1 * Abstand) / dl * (y2 - y1) '
If richt = "l" Or richt = "L" Then winkel1 = winkel + pi / 2
If richt = "r" Or richt = "R" Then winkel1 = winkel + 3 * pi / 2

If winkel1 >= 0 And winkel1 < (pi) Then x3 = x4 + Cos(winkel1) * lstrich: y3 = y4 + Sin(winkel1) * lstrich: linie = ActDr.Graphics.AddLineSingle(x4, y4, 0, x3, y3, 0)
If winkel1 >= pi And winkel1 < (2 * pi) Then x3 = x4 + Cos(winkel1) * lstrich: y3 = y4 + Sin(winkel1) * lstrich: linie = ActDr.Graphics.AddLineSingle(x4, y4, 0, x3, y3, 0)
k1 = k1 + 1
Länge = Länge + Abstand
Next jj

k = k + k1
Else
Länge = Länge + dl
End If

If Länge >= k * Abstand Then
ddl = Länge - k * Abstand       ' Zwischenpunkt bei geraden Abständen ermitteln
x4 = x1 + (dl - ddl) / dl * (x2 - x1): y4 = y1 + (dl - ddl) / dl * (y2 - y1) '
If richt = "l" Or richt = "L" Then winkel1 = winkel + pi / 2
If richt = "r" Or richt = "R" Then winkel1 = winkel + 3 * pi / 2

If winkel1 >= 0 And winkel1 < (pi) Then x3 = x4 + Cos(winkel1) * lstrich: y3 = y4 + Sin(winkel1) * lstrich: linie = ActDr.Graphics.AddLineSingle(x4, y4, 0, x3, y3, 0)
If winkel1 >= pi And winkel1 < (2 * pi) Then x3 = x4 + Cos(winkel1) * lstrich: y3 = y4 + Sin(winkel1) * lstrich: linie = ActDr.Graphics.AddLineSingle(x4, y4, 0, x3, y3, 0)

'Debug.Print k, Länge
k = k + 1
Else
End If

On Error Resume Next
Next i
'Debug.Print k, Länge
Else
End If



End Sub