' Einstellen in Regedit: ' HKEY_LOCAL_MACHINE\SOFTWARE\Nemetschek\Allplan\2012.0\settings ' VBScript --> \\...\VTB.vbs Function Now() Now = "Date " + CStr(Date) + " erste Zeile" & CHR(13) & "2.Zeile" End Function Function block(liste) blanc = InStr(1,liste," ") If blanc > 1 Then block = Mid(liste,1,blanc) + vbCr + Mid(liste,blanc+1,Len(liste)) Else block = liste End If End Function Function VTB_FORMAT(B,H) VTB_FORMAT = CStr(H) + "/" + CStr(B) if B=210 AND H=297 Then VTB_FORMAT = "A4" if B=420 AND H=297 Then VTB_FORMAT = "A3" if B=594 AND H=420 Then VTB_FORMAT = "A2" if B=841 AND H=594 Then VTB_FORMAT = "A1" if B=1189 AND H=841 Then VTB_FORMAT = "A0" if B=594 AND H=297 Then VTB_FORMAT = "A3.2" if B=841 AND H=297 Then VTB_FORMAT = "A3.1" if B=1189 AND H=297 Then VTB_FORMAT = "A3.0" if B=841 AND H=420 Then VTB_FORMAT = "A2.1" if B=1189 AND H=420 Then VTB_FORMAT = "A2.0" if B=1189 AND H=594 Then VTB_FORMAT = "A1.0" End Function Function VTB_BT(objekt,Dicke,Laenge,Hoehe,Material,Durchm) Dim name name = Mid(objekt,5,3) Dicke = Round(Dicke,3)*100 Laenge = Round(Laenge,3)*100 Durchm = Round(Durchm,3)*100 Hoehe = Round(Hoehe,3)*100 If name = "Wa " Then VTB_BT = "W: " + CStr(Dicke) + "/" + CStr(Hoehe) + " - " + Material ElseIf name = "St " Then If Durchm > 0 Then VTB_BT = "St: " + CStr(Durchm) + " - " + Material Else VTB_BT = "St: " + CStr(Dicke) + "/" + CStr(Laenge) + " - " + Material End If ElseIf name = "EFu" Then VTB_BT = "BlFd: " + CStr(Dicke) + "/" + CStr(Laenge) + " - " + Material ElseIf name = "Afk" Then VTB_BT = "Aufk: " + CStr(Dicke) + "/" + CStr(Hoehe) + " - " + Material ElseIf name = "Att" Then VTB_BT = "Attika: " + CStr(Dicke) + "/" + CStr(Hoehe) + " - " + Material ElseIf name = "SFu" Then VTB_BT = "StFd: " + CStr(Dicke) + "/" + CStr(Hoehe) + " - " + Material ElseIf name = "PFu" Then VTB_BT = "FPl: " + CStr(Hoehe) + " - " + Material ElseIf name = "Unz" Then VTB_BT = "Uz: " + CStr(Dicke) + "/" + CStr(Hoehe) + " - " + Material ElseIf name = "Srz" Then VTB_BT = "Stz: " + CStr(Dicke) + "/" + CStr(Hoehe) + " - " + Material ElseIf name = "De " Then VTB_BT = "D: " + CStr(Hoehe) + " - " + Material ElseIf name = "Ddu" Then If Durchm > 0 Then VTB_BT = "DD: " + CStr(Durchm) + "cm" Else VTB_BT = "DD: " + CStr(Dicke) + "/" + CStr(Laenge) + "cm" End If ElseIf name = "Das" Then If Durchm > 0 Then VTB_BT = "DA: " + CStr(Durchm) + "/" + CStr(Hoehe) + "cm" Else VTB_BT = "DA: " + CStr(Dicke) + "/" + CStr(Laenge) + "/" + CStr(Hoehe) + "cm" End If ElseIf name = "Fen" Then If Durchm > 0 Then VTB_BT = "WD: " + CStr(Durchm) + "cm" Else VTB_BT = "WD: " + CStr(Laenge) + "/" + CStr(Hoehe) + "cm" End If ElseIf name = "Tr" Then If Durchm > 0 Then VTB_BT = "WD: " + CStr(Durchm) + "cm" Else VTB_BT = "WD: " + CStr(Laenge) + "/" + CStr(Hoehe) + "cm" End If ElseIf name = "Wdu" Then If Durchm > 0 Then VTB_BT = "WD: " + CStr(Durchm) + "cm" Else VTB_BT = "WD: " + CStr(Laenge) + "/" + CStr(Hoehe) + "cm" End If ElseIf name = "Nis" Then VTB_BT = "WAs: " + CStr(Laenge) + "/" + CStr(Hoehe) + "/" + CStr(Dicke) + "cm" ElseIf name = "Wni" Then VTB_BT = "Asp: " + CStr(Laenge) + "/" + CStr(Hoehe) + "/" + CStr(Dicke) + "cm" ElseIf name = "BRr" Then VTB_BT = "BR: " + CStr(Durchm) + "/" + CStr(Hoehe) + "cm - " + Material ElseIf name = "BR" Then VTB_BT = "BR: " + CStr(Dicke) + "/" + CStr(Hoehe) + " - " + Material ElseIf name = "RBa" Then VTB_BT = "RA: " + CStr(Dicke) + "/" + CStr(Hoehe) + " - " + Material ElseIf name = "Wpf" Then VTB_BT = "WPF: " + CStr(Laenge) + "/" + CStr(Dicke) + "cm - " + Material 'Else VTB_BT = "Kein Bauteil erkannt" Else VTB_BT = objekt end If 'VTB_BT = objekt End Function Function VTB_HK(objekt,OK,UK,Durchm,Laenge) Dim name Dim RA name = Mid(objekt,5,3) If name = "Ddu" Then VTB_HK = Chr(9) Exit Function End If If Durchm = 0 Or name = "Das" Or name = "St " Then If OK = 0 Then VTB_HK = "OK%EA0,000%EE" ElseIf OK > 0 Then VTB_HK = "OK%EA+" + CStr(FormatNumber(OK/1000,3,-1-1)) + "%EE" Else VTB_HK = "OK%EA" + CStr(FormatNumber(OK/1000,3,-1-1)) + "%EE" End If If UK = 0 Then VTB_HK = VTB_HK + "UK%EA0,000%EE" ElseIf UK > 0 Then VTB_HK = VTB_HK + "UK%EA+" + CStr(FormatNumber(UK/1000,3,-1-1)) + "%EE" Else VTB_HK = VTB_HK + "UK%EA" + CStr(FormatNumber(UK/1000,3,-1-1)) + "%EE" End If Else RA = UK/1000 + Laenge/2 If RA = 0 Then VTB_HK = "RA%EA0,000%EE" ElseIf RA > 0 Then VTB_HK = "RA%EA+" + CStr(FormatNumber(RA,3,-1-1)) + "%EE" Else VTB_HK = "RA%EA" + CStr(FormatNumber(RA,3,-1-1)) + "%EE" End If End If End Function Function VTB_HBT(objekt,Dicke,Hoehe,Material,fkt) Dim xname xname = Mid(objekt,5,3) If xname = "Pfo" Then VTB_HBT = "Pfosten %W25A1" + CStr(Dicke) + "/" + CStr(Hoehe) ElseIf xname = "Spr" Then VTB_HBT = "Sparren %W25A1" + CStr(Dicke) + "/" + CStr(Hoehe) ElseIf xname = "Bal" Then VTB_HBT = "Balken %W25A1" + CStr(Dicke) + "/" + CStr(Hoehe) ElseIf xname = "Wes" Then VTB_HBT = "Wechsel %W25A1" + CStr(Dicke) + "/" + CStr(Hoehe) ElseIf xname = "Gsp" Then VTB_HBT = "Gratsp. %W25A1" + CStr(Dicke) + "/" + CStr(Hoehe) ElseIf xname = "Ksp" Then VTB_HBT = "Kehlsp. %W25A1" + CStr(Dicke) + "/" + CStr(Hoehe) ElseIf xname = "Pft" Then VTB_HBT = "Pfette %W25A1" + CStr(Dicke) + "/" + CStr(Hoehe) ElseIf xname = "Zng" Then VTB_HBT = "Zange %W25A1" + CStr(Dicke) + "/" + CStr(Hoehe) ElseIf xname = "Keb" Then VTB_HBT = "Kehlbalken %W25A1" + CStr(Dicke) + "/" + CStr(Hoehe) ElseIf xname = "SpP" Then VTB_HBT = "Sparrenpfette %W25A1" + CStr(Dicke) + "/" + CStr(Hoehe) ElseIf xname = "Hbt" Then VTB_HBT = fkt + " %W25A1" + CStr(Dicke) + "/" + CStr(Hoehe) Else VTB_HBT = "%W25A1" + CStr(Dicke) + "/" + CStr(Hoehe) If Material <> "" Then VTB_HBT = VTB_HBT + " (" + Material + ")" End If End If End Function ' WScript.Echo VTB_HBT("0000Hbt",0.14,0.16,"S10","Balken") ' WScript.Echo VTB_HK("0075Tr j221",0,-5224,150,0.25) ' WScript.Echo VTB_BT("0075Tr j221",0.25,0.5,1.5,"C25/30",0)