' File created on 20/12/2016 - 12:01:03

' Servorahmen nach VTH
sub srl_vth () 
dateiname = "c:\users\hermann\Dropbox\Modellflug\cad_cam\servorahmen_vth\param_sr_vth.txt"
p_all = ""
set fso = CreateObject("Scripting.FileSystemObject")
set datei = fso.OpenTextFile(dateiname, 1)
do while not (datei.atEndOfStream)
	satz = datei.ReadLine()
	p_all = p_all&satz&vbcrlf
	if left(satz,1) = "*" then
		Cad.Display satz
	else
		param = left(satz,instr(satz,chr(9))-1)
		param = replace(param," ","")
		split_tab = split(param,"=")
		select case split_tab(0)
			case "rh"
				rh = split_tab(1)*1 '* 1 weil val-funktion zu Fehler führte
			case "rb"
				rb = split_tab(1)*1
			case "ms"
				ms = split_tab(1)*1
			case "rsu"
				rsu = split_tab(1)*1
			case "rso"
				rso= split_tab(1)*1
			case "rbo"
				rbo = split_tab(1)*1
			case "rbu"
				rbu = split_tab(1)*1
			case "sl"
				sl = split_tab(1)*1
			case "sb"
				sb= split_tab(1)*1
			case "sll"
				sll = split_tab(1)*1
			case "lh"
				lh = split_tab(1)*1
			case "bh"
				bh = split_tab(1)*1
			case "a1"
				a1 = split_tab(1)*1
			case "a2"
				a2 = split_tab(1)*1
			case "a3"
				a3 = split_tab(1)*1
			case else
				Cad.Display "Fehler in Parameterdatei"		
		end select
	end if
loop
set datei = nothing
'cad.display p_all

'unteren Rahmen zeichnen

Cad.SendCommand "RECTANG"
cad.sendpoint 0,0
cad.sendpoint rb,rh

cad.sendcommand "RECTANG"
cad.sendpoint rsu,rsu
x = rb - rsu
y = rh - rsu
cad.sendpoint x,y

sendcommand "CHAMFER"
Cad.SendCommand "A"
cad.senddouble rsu * 1.15
cad.senddouble 45
Cad.SendCommand "p"
cad.sendpoint x,y

rahmen_bohrungen rh, rb, rsu, rbu, rbu

'oberen Rahmen zeichnen

x = rb + 10
y = 0
Cad.SendCommand "RECTANG"
cad.sendpoint x,y
x = x + rb
y = y + rh
cad.sendpoint x,y

x = rb + 10 + rso
y = rso
Cad.sendcommand "RECTANG"
cad.sendpoint x,y
x = x + rb - 2 * rso
y = y + rh - 2 * rso
Cad.SendPoint x,y

Cad.SendCommand "FILLET"
Cad.SendCommand "r"
Cad.SendDouble rso * 2/3
Cad.SendCommand "P"
cad.sendpoint x,y

'Deckel zeichnen
Cad.SendCommand "MOVE_UCS_ORIGIN"
x = rb * 2 + 20
y = 0
cad.sendpoint x,y

rahmen_bohrungen rh, rb, rsu, rbu, rbo

x = rso + 0.15
y = rso + 0.15
Cad.SendCommand	"RECTANG"
Cad.SendPoint x,y
x = rb - rso - 0.15
y = rh - rso - 0.15
Cad.SendPoint x,y

'Ecken abrunden
Cad.SendCommand "FILLET"
Cad.SendCommand "R"
Cad.SendDouble rso * 2/3
Cad.SendCommand "P"
cad.sendpoint x,y

'senkrechte Aussparung fuer Servorahmen
xu = a1 + rso
yu = (rh - sl - 2*sll) / 2 - 0.15
Cad.SendCommand "RECTANG"
Cad.SendPoint xu,yu
xo = xu + 2 * ms + 2 * 0.15
yo= yu + sl + 2 * sll + 2 * 0.15
Cad.SendPoint xo,yo

'untere waagrechte Aussparung für Servorahmen 
x1 = xu - sb+ 2 * ms
y = yu
cad.sendcommand "RECTANG"
Cad.SendPoint x1,y
x2 = x1 + sb  * 3/4 + 0.15 - 2 * ms
dx = x2 - x1 - 2*0.15
y = y+ms +2* 0.15
Cad.SendPoint x2,y

'obere waagrechte Aussparung für Servorahmen
y = yo - ms - 2*0.15
Cad.SendCommand "RECTANG"
cad.sendpoint x1,y
y = y + ms +2* 0.15
Cad.SendPoint x2,y

'Hebelausschnit
x = a2
y = a3 + rbo
cad.sendcommand "RECTANG"
Cad.SendPoint x,y
x = x + bh
y = y + lh
Cad.SendPoint x,y

'Hebelausschnitt verrunden
Cad.SendCommand "FILLET"
Cad.SendCommand "r"
Cad.SendDouble bh/2
Cad.SendCommand "P"
cad.sendpoint x,y

'Servoauflage Zeichnen
x= 0
y = -10
Cad.SendCommand "PLINE"
Cad.SendPoint x,y
x=x+sl+2*sll
Cad.SendPoint x,y
dy = (sb + ms)/3
y = y - dy
Cad.SendPoint x, y
x = x - ms 
cad.sendpoint x,y
y = y -dy
Cad.SendPoint x,y
x = x + ms 
Cad.SendPoint x,y
y = y - dy
Cad.SendPoint x,y
x = x - sll
Cad.SendPoint x,y
y = y + sb
Cad.SendPoint x,y
x = x - sl
Cad.SendPoint x,y
y = y - sb
Cad.SendPoint x,y
x = x - sll
Cad.SendPoint x,y
y = y + dy
Cad.SendPoint x,y
x = x + ms 
Cad.SendPoint x,y
y = y + dy
Cad.SendPoint x,y
x = x - ms 
Cad.SendPoint x,y
y = y + dy
Cad.SendPoint x,y
Cad.SendCommand ""

'Auflagenstütze zeichnen
x = x - rb
y = - 10
xa = x
ya = y
Cad.SendCommand "PLINE"
Cad.SendPoint x,y
y = y - dy
Cad.SendPoint x,y
x = x + 2 * ms
Cad.SendPoint x,y
y = y - dy
Cad.SendPoint x,y
x = x - 2 * ms 
Cad.SendPoint x,y
y = y-(dy-ms)
Cad.SendPoint x,y
x = x  - (sb - dx - 2*ms)
Cad.SendPoint x,y
y = y - ms
Cad.SendPoint x,y
x = x - dx
Cad.SendPoint x,y
y = y + ms * 1.5
Cad.SendPoint x,y
x  = xa-ms
y = ya
Cad.SendPoint x,y
x = x + ms 
Cad.SendPoint x,y
Cad.SendCommand ""

end sub



'*********************************

' Hilfsroutine Rahmenbohrungen
sub rahmen_bohrungen (rh,rb,rsu,rbu, r)
x1 = rsu + rbu
y = rsu + rbu
Cad.SendCommand "Circle"
Cad.SendPoint x1,y
Cad.SendDouble r

x = rb - rsu - rbu
Cad.SendCommand "Circle"
Cad.SendPoint x,y
Cad.SendDouble r

y = rh - rsu - rbu
Cad.SendCommand "Circle"
Cad.SendPoint x,y
Cad.SendDouble r

Cad.SendCommand "Circle"
Cad.SendPoint x1,y
Cad.SendDouble r

end sub 