Thanks AlwMVMO
I found mistake. Should be fine now.
I found mistake. Should be fine now.
Code:
'-------WRITE BY QUARKQ PAWEL S.-------------------------------------------
Sub Main()
Begin Dialog SPROCKETDIALOG 50,47, 182, 94, "Sprocket Maker"
Text 4,10,65,12, "Number of Teetch"
TextBox 68,8,49,12, .IDD_Tn
Text 4,26,65,12, "Pitch of Chain"
TextBox 68,24,49,12, .IDD_P
Text 4,42,97,12, "Roler Diameter"
TextBox 68,40,49,12, .IDD_Rd
Text 4,58,97,12, "Roller Clearance"
TextBox 68,56,49,12, .IDD_Backlash
Text 4,72,97,12, "Centre Hole_D"
TextBox 68,72,49,12, .IDD_j
OKButton 136,15,37,12
CancelButton 136,40,37,12
End Dialog
Dim dlg As SprocketDialog
Dim si As Double
Dim ti As Double
Dim s As Double
Dim t As Double
Dim x As Double
Dim y As Double
Dim d As Double
Dim xp As Double
Dim yp As Double
Dim a As Double
Dim b As Double
Dim c As Double
Dim r0 As Double
Dim r1 As Double
Dim xt56 As Double
Dim yt56 As Double
Dim xt78 As Double
Dim yt78 As Double
dcSetDrawingScale 1.0
dcSetDrawingUnits dcMillimeters
dcSetLineParms dcBLACK, dcSOLID, dcNORMAL
dcSetCircleParms dcBLACK, dcSOLID, dcNORMAL
dcSetPointParms dcRED, False
dlg.IDD_Tn = "18" 'Teetch number
dlg.IDD_P = "9.525" 'Pitch
dlg.IDD_Rd = "6.5" 'Roler circle
dlg.IDD_Backlash = "0.1"
dlg.IDD_j = "10"
Button = Dialog(dlg)
If Button = -1 Then
Sprock dlg.IDD_Tn,dlg.IDD_P,dlg.IDD_Rd,dlg.IDD_Backlash,dlg.IDD_j,0,0
dcViewAll
End If
End Sub
Sub Sprock(ByVal Tn As Double,ByVal P As Double,ByVal Rd As Double,ByVal BACKLASH As Double,ByVal j As Double, ByVal cx As Double, ByVal cy As Double)
Pi=3.1415926535897932384626433832795028841971
Pr =(P/Sin((180/Tn)*pi/180))/2 '(((P * Tn) / Pi) / 2 ) 'Pitch Diameter
W=(Pr+(Rd*0.35))-(Pr+(Rd*0.25))
dcSelectAll
dcEraseSelObjs
dcCreateLine 0, 0, 0, Pr+(Rd*0.35)
'dcCreateCircle 0, 0, Pr 'Pitch Diameter
'dcCreateCircle 0, 0, Pr+(Rd*0.25) 'Pitch Circumferen ce 25% of Roller Diameter
'dcCreateCircle 0, Pr, (Rd+Backlash)/2 'Roler circle plus 0.1
'dcCreateCircle 0, W/2+(Pr+(Rd*0.25)) ,W/2 'Little circle
'dcCreateCircleEx 0, W/2+(Pr+(Rd*0.25)), 90, -90, 0, 90, w/2, w/2, 0, 0 'Little circle
dcCreateCircle 0, 0, j/2
dcSelectObjInBox -1, Pr+(Rd*0.25), 1,W/2+(Pr+(Rd*0.25))
dcSetSelectBase 0, 0
dcRotateSelObjs 360/Tn/2
dcSetSelCopyMode True
dcRotateSelObjs (360/Tn/2)*(Tn-1)*2
dcMirrorSelObjs 0, 0, 0, 2
dcUnSelectAll
s=0
t=(W/2)+(Pr+(Rd*0.25))
si=s*Cos(((360/Tn/2)*Pi)/180)-t*Sin(((360/Tn/2)*Pi)/180) 'X smaller circle center
ti=s*Sin(((360/Tn/2)*Pi)/180)+t*Cos(((360/Tn/2)*Pi)/180) 'Y smaller circle center
'little circle end point 2
m=0
n=Pr+(Rd*0.35)
mi=m*Cos(((360/Tn/2)*Pi)/180)-n*Sin(((360/Tn/2)*Pi)/180) 'X smal circle center
ni=m*Sin(((360/Tn/2)*Pi)/180)+n*Cos(((360/Tn/2)*Pi)/180) 'Y smal circle center
'circle big one
a=0 'x1 =
b=Pr 'y1 =
r0=((Rd+Backlash)/2) 'r1 =
'circle 2 little one right
c=si *-1 'x2 =
d=ti 'y2 =
r1=(W/2) 'r0
xp=((c*r0)+(a*r1))/(r0+r1)
yp=((d*r0)+(b*r1))/(r0+r1)
xt56=(((r0^2*(xp-a))+r0*(yp-b)*Sqr((xp-a)^2+(yp-b)^2-r0^2))/((xp-a)^2+(yp-b)^2))+a
yt56=(((r0^2*(yp-b))-r0*(xp-a)*Sqr((xp-a)^2+(yp-b)^2-r0^2))/((xp-a)^2+(yp-b)^2))+b
xt78=(((r1^2*(xp-c))+r1*(yp-d)*Sqr((xp-c)^2+(yp-d)^2-r1^2))/((xp-c)^2+(yp-d)^2))+c
yt78=(((r1^2*(yp-d))-r1*(xp-c)*Sqr((xp-c)^2+(yp-d)^2-r1^2))/((xp-c)^2+(yp-d)^2))+d
dcCreateLine xt56,yt56,xt78,yt78 ' tangent line on right
dcSelectObjInBox xt56+0.2,yt56+0.2,xt78-0.2,yt78-0.2
dcSetSelCopyMode True
dcMirrorSelObjs 0, 0, 0, 2 'mirror line
dcUnSelectAll
'proba duzego na promien
dcCreateCircleEx 0, Pr, -xt56, yt56, xt56, yt56, (Rd+Backlash)/2, (Rd+Backlash)/2, 0, 0
dcCreateCircleEx si, ti, -xt78, yt78, mi, ni, W/2, W/2, 0, 0
dcSelectObjInBox si+0.1, ti, si+0.2,ti+30
dcSetSelCopyMode True
dcMirrorSelObjs 0, 0, 0, 2
dcUnSelectAll
dcSelectObjInBox -1, -1, 1, 1
dcEraseSelObjs
dcUnSelectAll
dcSelectAll
dcSetSelectBase 0, 0
For z=0 to Tn-1
dcRotateSelObjs 360/Tn
dcSetSelCopyMode True
Next z
dcUnSelectAll
dcSetTextParms dcRED, “Arial”, “Normalny”, 0,2,0, 0.1, 0
dcCreateText 0, -5, 3, "Teeth="
dcCreateText 2.4, -5, 3,Tn
dcCreateText 0, -6, 3, "Pitch="
dcCreateText 2.2, -6, 3,P
dcCreateText 0, -7, 3, "Roller_D="
dcCreateText 3.6, -7, 3.5,Rd
dcCreateText 0, -8, 3, "Pitch_D="
dcCreateText 3.3, -8, 4,Pr*2
dcCreateText 0, -9, 3, "Max_D="
dcCreateText 3, -9, 4,(Pr+(Rd*0.35))*2
End Sub