'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright by Weinmann Holzbausystemtechnik GmbH (c) 2004
'
' Filename:
'
' Description:
'
' Author:                tb32sot
'
' Date:                        20040121
'
' Version:                V0.01
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

SUB MAIN

 DIM dPX(16)
 DIM i
 DIM sIni
 DIM SLOPE_DEFAULT
 DIM RAD_ANGLE
 const MACROTITLE = "Macro"

 SLOPE_DEFAULT = 30

 'Holen Parameterbezeichnungen abhaengig von der Landessprache
 sIni = "l" + GETACTUALLANGUAGE() + ".ini"

IF NOT FINDFIRSTSELECTED THEN
	DIM BEAMCOUNTER

	BEAMCOUNTER = GETCOUNTTYPE(CalcType("LS"))
	BEAMCOUNTER = BEAMCOUNTER + GETCOUNTTYPE(CalcType("QS"))
	BEAMCOUNTER = BEAMCOUNTER + GETCOUNTTYPE(CalcType("BT4"))
	BEAMCOUNTER = BEAMCOUNTER + GETCOUNTTYPE(CalcType("BT6"))

	IF BEAMCOUNTER = 1 THEN
		IF GETCOUNTTYPE(CalcType("LS")) = 1 THEN
			FINDFIRSTTYPE(CalcType("LS"))
		END IF
		IF GETCOUNTTYPE(CalcType("QS")) = 1 THEN
			FINDFIRSTTYPE(CalcType("QS"))
		END IF
		IF GETCOUNTTYPE(CalcType("BT4")) = 1 THEN
			FINDFIRSTTYPE(CalcType("BT4"))
		END IF
		IF GETCOUNTTYPE(CalcType("BT6")) = 1 THEN
			FINDFIRSTTYPE(CalcType("BT6"))
		END IF
	ELSE
	  MsgBox GETPRIVATEPROFILESTRING("Fehler", "F1", " ", sIni), _
		vbOkOnly + vbCritical + vbSystemModal,"Error"
	  exit sub
	END IF
END IF

IF NOT ( ISBEAM OR ( ISBEAMPROCESSING AND SELECTPARENTBEAM() ) ) THEN

	  MsgBox GETPRIVATEPROFILESTRING("Fehler", "F2", " ", sIni), _
		vbOkOnly + vbCritical + vbSystemModal,"Error"
	  exit sub
END IF

FOR i = LBOUND(dPX) TO UBOUND(dPX)
    dPX(i) = 0.0
NEXT

dPX(0) = 2 '  always ebene 2
dPX(2) = 1 ' always referenced to front of the balken
dPX(11) = GETPARAM(3) / 2 ' always half of the balken height
dPX(13) = 0 ' no drilling
dPX(16) = 2 ' always anfgang orientiert

dPX(6) = GetTempParam(0)
IF dPX(6) = 0 THEN
   dPX(6) = SLOPE_DEFAULT
END IF

dPX(6) = InputBoxF("P100:" & vbCrLf & vbCrLf & " ",MACROTITLE,dPX(6))
IF bInputBoxCancel = 1 THEN
   EXIT SUB
END IF
SetTempParam 0,dPX(6)

dPX(6) = 180-(2*dPX(6))
RAD_ANGLE = ( (dPX(6)-90) * PI ) / 180
dPX(1) = GETPARAM(2) * TAN ( RAD_ANGLE )
dPX(12) = GETPARAM(2) / COS( RAD_ANGLE )

'DIM RETVAL
'RETVAL = BTLFUNCTION(dPX(16),30,dPX(0),dPX(1),dPX(2),dPX(3),dPX(4),dPX(5),dPX(6),dPX(7),dPX(8),dPX(9),dPX(10),dPX(11),dPX(12),dPX(13),dPX(14),dPX(15))
'IF NOT RETVAL THEN
'   MsgBox GETLASTERROR,vbOkOnly + vbCritical + vbSystemModal,"Error"
'END IF
if dPX(6) > 90 THEN
	SG dPX(1),0,GETPARAM(3), dPX(6), 90, GETPARAM(3), 2, 2, 0, 1
END IF
PAF 2
PP dPX(1),0,-dPX(11), 121, 0,0
PP dPX(1)+dPX(12),0,-dPX(11), 121, 0,0
PP dPX(12),GETPARAM(2),-dPX(11), 121, 0,0
PP 0,GETPARAM(2),-dPX(11), 121, 0,0
PP dPX(1),0,-dPX(11), 121, 0,0


END SUB

MAIN
