Attribute VB_Name = "Module1" 'Macro w-multi_nn, Version 2 vom 25.05.2001 Public multi! Public Projekt$ Public PDatum(7) As String Public PTitel As String Public thw As String Public tnw As String Public horizont As Integer Public giw As Integer Sub main() Dim accepted As Integer Dim elem As New MbeElement 'defines an object called elem in which we 'will keep our element Dim filePos As Long Dim status As Integer Dim texte As String Dim text1 As String Dim text2 As String Dim punkt As MbePoint Dim punkt1 As MbePoint Dim answer$ as string Dim Bauteil As New MbeElement Dim Point As MbePoint Dim varia(21, 7) As String Dim reihe As Integer Dim i, lauf As Integer Dim suggest As String Dim symboldatei As String Dim sym60 As Integer Dim sym70 As Integer Dim symnull As Integer Dim symw1 As Integer Dim symw2 As Integer Dim symw3 As Integer Dim multisym As Integer Dim filename As String Dim xs As Double Dim ys As Double Dim button As Long multisym = 1 actionButton = mbeOpenModalDialog(1) '*********************** Symboldatei bestimmen If sym60 > 0 Then symboldatei = "wsa60.sym" ElseIf sym70 > 0 Then symboldatei = "wsa70.sym" ElseIf symnull > 0 Then symboldatei = "wsanullmess.sym" ElseIf symw1 > 0 Then symboldatei = "wsaw1.sym" ElseIf symw2 > 0 Then symboldatei = "wsaw2.sym" ElseIf symw3 > 0 Then symboldatei = "wsaw3.sym" ElseIf multisym > 0 Then symboldatei = "wsamulti.sym" Else symboldatei = "wsanullmess.sym" End If If tnw = "" Then tnw = "1.40" If thw = "" Then thw = "1" If multi = 0 Then answer = MbeInputBox("Bitte Überhöhung eingeben:", "10.0", "Höhen-Multiplikation") multi = val(answer) End If If Projekt = "" Then Projekt = MbeInputBox("Bitte Projekt eingeben:", , "Projekt") End If accepted = False While Not accepted MbeStartLocate MbeWritePrompt "Nullinie wählen..." MbeGetInput MBE_DataPointInput, _ MBE_ResetInput MbeSendLastInput filePos = elem.fromLocate() stat = elem.getEndPoints(punkt, punkt1) While MbeState.CmdResult = MBE_AcceptQuery And Not accepted MbeWritePrompt "Bestätigen/Reset" MbeGetInput MBE_DataPointInput, _ MBE_ResetInput MbeSendLastInput Select Case MbeState.InputType Case MBE_ResetInput filePos = elem.fromLocate() Case MBE_DataPointInput accepted = True End Select Wend Wend MbeSettings.font = 151 MbeSettings.angle = 0 MbeSettings.color = 0 MbeSettings.level = 60 MbeSettings.linestyle = 0 MbeSettings.weight = 0 MbeSettings.textheight = 1 MbeSettings.textwidth = 1 MbeSettings.textjustification = 13 MbeSettings.textLineSpacing = 2 MbeSendCommand "place line" MbeSendDataPoint punkt.x, punkt.y, (punkt.z + (val(thw) * multi)), 1 MbeSendDataPoint punkt1.x, punkt1.y, (punkt1.z + (val(thw) * multi)), 1 MbeSendReset MbeSendCommand "place line" MbeSendDataPoint punkt.x, punkt.y, (punkt.z - (val(tnw) * multi)), 1 MbeSendDataPoint punkt1.x, punkt1.y, (punkt1.z - (val(tnw) * multi)), 1 MbeSendReset If giw = 1 Then text1 = "GIW " + str$(horizont / multi + val(thw)) + " m NN" text2 = "AMW " + str$(horizont / multi - val(tnw)) + " m NN" Else text1 = "MThw " + str$(horizont / multi + val(thw)) + " m NN" text2 = "MTnw " + str$(horizont / multi - val(tnw)) + " m NN" End If MbeSendCommand "place text" MbeSendKeyin text1 MbeSendDataPoint (punkt.x - 12), punkt.y, (punkt.z + (val(thw) * multi)), 1 MbeSendKeyin text2 MbeSendDataPoint (punkt.x - 12), punkt.y, (punkt.z - (val(tnw) * multi)), 1 MbeSendReset MbeSettings.color = 0 MbeSettings.level = 61 MbeSendCommand "place text" MbeSendKeyin str$(horizont / multi) & ".00 m NN" MbeSendDataPoint (punkt.x - 12), punkt.y, punkt.z, 1 MbeSendReset '******** Überschrift, PDatum und Station schreiben MbeSettings.textjustification = 7 MbeSettings.level = 5 MbeSendCommand "place text" texte = PTitel MbeSendKeyin texte MbeSendDataPoint (punkt.x + 50), punkt.y, (punkt.z + 8 * multi), 1 MbeSendReset MbeSettings.level = 6 MbeSendCommand "place text" texte = Projekt + Chr$(10) + ltrim$(str$(multi)) + "-fache Überhöhung" MbeSendKeyin texte MbeSendDataPoint (punkt.x + 50), punkt.y, (punkt.z + 6 * multi), 1 MbeSendReset MbeSettings.textjustification = 13 MbeSettings.level = 4 MbeSendCommand "place text" MbeSendKeyin "Station" MbeSendDataPoint (punkt.x - 10), punkt.y, (punkt.z - 5 * multi - 3), 1 MbeSendReset lauf = 0 For i = 1 To 7 If PDatum(i) <> "" Then MbeSendCommand "place text" MbeSendKeyin PDatum(i) MbeSendDataPoint (punkt.x - 10), punkt.y, (punkt.z - 5 * multi - 8.5 - 5 * lauf), 1 MbeSendReset lauf = lauf + 1 End If Next i MbeSendCommand "ECHO" suggest$ = symboldatei filter$ = "*.sym" directory$ = "MS_MACRO" title$ = "Symboldatei-Datei wählen" filename$ = "" status = MbeFileOpen(filename$, suggest$, filter$, directory$, title$) If status = Mbe_success Then Open filename For Input As #1 If multisym = 1 Then For reihe = 0 To 21 Input #1, varia(reihe, 0), varia(reihe, 1), varia(reihe, 2), varia(reihe, 3), varia(reihe, 4), varia(reihe, 5), varia(reihe, 6) Next reihe Else For reihe = 0 To 9 input #1, varia(reihe,0),varia(reihe,1),varia(reihe,2),varia(reihe,3),_ varia(reihe,4),varia(reihe,5),varia(reihe,6) Next reihe End If Close filePos = Bauteil.fromFile(0) Do While filePos >= 0 status = Bauteil.getorigin(Point) If status = Mbe_success Then Bauteil.changeAll = True Select Case Bauteil.level Case 4 '****** Topotexte If Bauteil.type = MBE_Text Then Bauteil.font = val(varia(3, 0)) Bauteil.level = val(varia(3, 1)) Bauteil.color = val(varia(3, 2)) Bauteil.style = varia(3, 3) Bauteil.weight = val(varia(3, 4)) xs = val(varia(3, 5)) ys = val(varia(3, 6)) stat = Bauteil.scale(xs, xs, ys, Point) ElseIf Bauteil.type = Mbe_Line Then Bauteil.level = val(varia(3, 1)) Bauteil.color = val(varia(3, 2)) Bauteil.style = varia(3, 3) Bauteil.weight = val(varia(3, 4)) End If stat = Bauteil.rewrite() Case 5 '****** Überschriften1 If Bauteil.type = MBE_Text Or Bauteil.type = MBE_TextNode Then Bauteil.font = val(varia(4, 0)) Bauteil.level = val(varia(4, 1)) Bauteil.color = val(varia(4, 2)) Bauteil.style = varia(4, 3) Bauteil.weight = val(varia(4, 4)) xs = val(varia(4, 5)) ys = val(varia(4, 6)) stat = Bauteil.scale(xs, xs, ys, Point) ElseIf Bauteil.type = Mbe_Line Then Bauteil.level = val(varia(4, 1)) Bauteil.color = val(varia(4, 2)) Bauteil.style = varia(4, 3) Bauteil.weight = val(varia(4, 4)) End If stat = Bauteil.rewrite() Case 6 '****** Überschriften2 If Bauteil.type = MBE_Text Or Bauteil.type = MBE_TextNode Then Bauteil.font = val(varia(5, 0)) Bauteil.level = val(varia(5, 1)) Bauteil.color = val(varia(5, 2)) Bauteil.style = varia(5, 3) Bauteil.weight = val(varia(5, 4)) xs = val(varia(5, 5)) ys = val(varia(5, 6)) stat = Bauteil.scale(xs, xs, ys, Point) ElseIf Bauteil.type = Mbe_Line Then Bauteil.level = val(varia(5, 1)) Bauteil.color = val(varia(5, 2)) Bauteil.style = varia(5, 3) Bauteil.weight = val(varia(5, 4)) End If stat = Bauteil.rewrite() Case 34 '****** Geländelinie 1.WM If Bauteil.type = MBE_Text Then Bauteil.font = val(varia(14, 0)) Bauteil.level = val(varia(14, 1)) Bauteil.color = val(varia(14, 2)) Bauteil.style = varia(14, 3) Bauteil.weight = val(varia(14, 4)) xs = val(varia(14, 5)) ys = val(varia(14, 6)) stat = Bauteil.scale(xs, xs, ys, Point) ElseIf Bauteil.type = Mbe_Line Then Bauteil.level = val(varia(15, 1)) Bauteil.color = val(varia(15, 2)) Bauteil.style = varia(15, 3) Bauteil.weight = val(varia(15, 4)) End If stat = Bauteil.rewrite() Case 35 '****** Geländelinie 2.WM If Bauteil.type = MBE_Text Then Bauteil.font = val(varia(16, 0)) Bauteil.level = val(varia(16, 1)) Bauteil.color = val(varia(16, 2)) Bauteil.style = varia(16, 3) Bauteil.weight = val(varia(16, 4)) xs = val(varia(16, 5)) ys = val(varia(16, 6)) stat = Bauteil.scale(xs, xs, ys, Point) ElseIf Bauteil.type = Mbe_Line Then Bauteil.level = val(varia(17, 1)) Bauteil.color = val(varia(17, 2)) Bauteil.style = varia(17, 3) Bauteil.weight = val(varia(17, 4)) End If stat = Bauteil.rewrite() Case 36 '****** Geländelinie 3.WM If Bauteil.type = MBE_Text Then Bauteil.font = val(varia(18, 0)) Bauteil.level = val(varia(18, 1)) Bauteil.color = val(varia(18, 2)) Bauteil.style = varia(18, 3) Bauteil.weight = val(varia(18, 4)) xs = val(varia(18, 5)) ys = val(varia(18, 6)) stat = Bauteil.scale(xs, xs, ys, Point) ElseIf Bauteil.type = Mbe_Line Then Bauteil.level = val(varia(19, 1)) Bauteil.color = val(varia(19, 2)) Bauteil.style = varia(19, 3) Bauteil.weight = val(varia(19, 4)) End If stat = Bauteil.rewrite() Case 37 '****** Geländelinie 4.WM If Bauteil.type = MBE_Text Then Bauteil.font = val(varia(20, 0)) Bauteil.level = val(varia(20, 1)) Bauteil.color = val(varia(20, 2)) Bauteil.style = varia(20, 3) Bauteil.weight = val(varia(20, 4)) xs = val(varia(20, 5)) ys = val(varia(20, 6)) stat = Bauteil.scale(xs, xs, ys, Point) ElseIf Bauteil.type = Mbe_Line Then Bauteil.level = val(varia(21, 1)) Bauteil.color = val(varia(21, 2)) Bauteil.style = varia(21, 3) Bauteil.weight = val(varia(21, 4)) End If stat = Bauteil.rewrite() Case 33 '****** Nullmessung If Bauteil.type = MBE_Text Then Bauteil.font = val(varia(2, 0)) Bauteil.level = val(varia(2, 1)) Bauteil.color = val(varia(2, 2)) Bauteil.style = varia(2, 3) Bauteil.weight = val(varia(2, 4)) xs = val(varia(2, 5)) ys = val(varia(2, 6)) stat = Bauteil.scale(xs, xs, ys, Point) ElseIf Bauteil.type = Mbe_Line Then Bauteil.level = val(varia(6, 1)) Bauteil.color = val(varia(6, 2)) Bauteil.style = varia(6, 3) Bauteil.weight = val(varia(6, 4)) End If stat = Bauteil.rewrite() Case 38 '****** Geländelinie 70ger If Bauteil.type = MBE_Text Then Bauteil.font = val(varia(12, 0)) Bauteil.level = val(varia(12, 1)) Bauteil.color = val(varia(12, 2)) Bauteil.style = varia(12, 3) Bauteil.weight = val(varia(12, 4)) xs = val(varia(12, 5)) ys = val(varia(12, 6)) stat = Bauteil.scale(xs, xs, ys, Point) ElseIf Bauteil.type = Mbe_Line Then Bauteil.level = val(varia(13, 1)) Bauteil.color = val(varia(13, 2)) Bauteil.style = varia(13, 3) Bauteil.weight = val(varia(13, 4)) End If stat = Bauteil.rewrite() Case 39 '****** Geländelinie 60ger If Bauteil.type = MBE_Text Then Bauteil.font = val(varia(10, 0)) Bauteil.level = val(varia(10, 1)) Bauteil.color = val(varia(10, 2)) Bauteil.style = varia(10, 3) Bauteil.weight = val(varia(10, 4)) xs = val(varia(10, 5)) ys = val(varia(10, 6)) stat = Bauteil.scale(xs, xs, ys, Point) ElseIf Bauteil.type = Mbe_Line Then Bauteil.level = val(varia(11, 1)) Bauteil.color = val(varia(11, 2)) Bauteil.style = varia(11, 3) Bauteil.weight = val(varia(11, 4)) End If stat = Bauteil.rewrite() Case 59 '****** Geländelinie wie Nullmessung If Bauteil.type = MBE_Text Then Bauteil.font = val(varia(2, 0)) Bauteil.level = val(varia(2, 1)) Bauteil.color = val(varia(2, 2)) Bauteil.style = varia(2, 3) Bauteil.weight = val(varia(2, 4)) xs = val(varia(2, 5)) ys = val(varia(2, 6)) stat = Bauteil.scale(xs, xs, ys, Point) ElseIf Bauteil.type = Mbe_Line Then Bauteil.level = val(varia(6, 1)) Bauteil.color = val(varia(6, 2)) Bauteil.style = varia(6, 3) Bauteil.weight = val(varia(6, 4)) End If stat = Bauteil.rewrite() Case 60 '****** Nullinie If Bauteil.type = MBE_Text Then Bauteil.font = val(varia(0, 0)) Bauteil.level = val(varia(0, 1)) Bauteil.color = val(varia(0, 2)) Bauteil.style = varia(0, 3) Bauteil.weight = val(varia(0, 4)) xs = val(varia(0, 5)) ys = val(varia(0, 6)) stat = Bauteil.scale(xs, xs, ys, Point) ElseIf Bauteil.type = Mbe_Line Then Bauteil.level = val(varia(8, 1)) Bauteil.color = val(varia(8, 2)) Bauteil.style = varia(8, 3) Bauteil.weight = val(varia(8, 4)) End If stat = Bauteil.rewrite() Case 61 '****** MThw/MTnw-Linie If Bauteil.type = MBE_Text Then Bauteil.font = val(varia(1, 0)) Bauteil.level = val(varia(1, 1)) Bauteil.color = val(varia(1, 2)) Bauteil.style = varia(1, 3) Bauteil.weight = val(varia(1, 4)) xs = val(varia(1, 5)) ys = val(varia(1, 6)) stat = Bauteil.scale(xs, xs, ys, Point) ElseIf Bauteil.type = Mbe_Line Then Bauteil.level = val(varia(9, 1)) Bauteil.color = val(varia(9, 2)) Bauteil.style = varia(9, 3) Bauteil.weight = val(varia(9, 4)) End If stat = Bauteil.rewrite() Case 62 '****** Station, Balken If Bauteil.type = MBE_Text Then Bauteil.font = val(varia(7, 0)) Bauteil.level = val(varia(7, 1)) Bauteil.color = val(varia(7, 2)) Bauteil.style = varia(7, 3) Bauteil.weight = val(varia(7, 4)) xs = val(varia(7, 5)) ys = val(varia(7, 6)) stat = Bauteil.scale(xs, xs, ys, Point) ElseIf Bauteil.type = Mbe_Line Then Bauteil.level = val(varia(7, 1)) Bauteil.color = val(varia(7, 2)) Bauteil.style = varia(7, 3) Bauteil.weight = val(varia(7, 4)) End If stat = Bauteil.rewrite() End Select End If filePos = Bauteil.fromFile(filePos + Bauteil.fileSize) Loop MbeSendCommand "SET LEVELS OFF 10" MbeSendCommand "SELVIEW 1" MbeSendCommand "SET LEVELS OFF 63" MbeSendCommand "SELVIEW 1" MbeSendCommand "FIT VIEW EXTENDED 1" Else button = MbeMessageBox("Programm durch Benutzer abgebrochen") End If End Sub