Egy kedves Fórumtársunknak lézereztem ezeket a formákat,3mm-es víztiszta plexiből:



És,miután Ő "felöltözteti" a plexit,....... ez lesz belőle:

Előzmény: Törölt felhasználó, 2011-07-16 23:30:00 [6098]

Fiúk!
Már csevegő lett ez a topik is?

Szerintem, mindenkinek jobb, ha nem mindenhol csak katyvasz van. Figyeljünk erre egy kicsit.

Előzmény: PSoft, 2011-07-16 22:39:00 [6097]

"Átteszem egy Inteles gépre. Lehet, hogy az AMD az oka."

A hét elején kezdtem próbálgatni a
szervovezérlőimet egy új építésű kis gravírgépen.

Mach-3 már régebben telepítve volt a PC-re,most kezdtem élesben próbálni a szervókat.
Nagyon egyenetlen járás mindhárom tengelyen,akárhova is állítgattam a vezérlőket.
Sikerült két FET-et is a másvilágra küldenem a vezérlőkben.
A drivertest-et nézve a Mach-ban,mintha cikcakk varrógéppel rajzolták volna.
Egyszerűen nem tudtam hovatenni a dolgot,P4-es lap 2.4-es proci,1,5G ram van a gépben.
Nagyon jó kis "pörgős" gép.
Aztán hirtelen jött a felismerés,.......b@ssza meg,......AMD-s proci/alaplap van a gépben

Megint belefutottam az AMD-s csapdába,pedig,már egy-kétszer szívatott régebben is.

Összedobtam egy hasonló paraméterekkel bíró INTEL-es gépet,és láss csodát,kapásból olyan a MACH driverteszt-je,mintha vonalzóval rajzolták volna.
Úgy járnak a motorok,mint ahogy járniuk kell,ugrálás,remegés nélkül.

Nem tudom ki,hogy van vele,de nekem még egyszer sem sikerült a MACH-ot összehozni az AMD-vel,csak virtuálisan.

"Lehet, hogy az AMD az oka."

Meggyőződésem,..... biztos,hogy az AMD az oka.

Előzmény: Miki2, 2011-07-16 21:10:00 [6096]

Holnap kipróbálok még valamit.
Átteszem egy Inteles gépre. Lehet, hogy az AMD az oka.
Régebben már jártam így egy másik programmal, és ez most megint belémnyilallt.

Előzmény: D.Laci, 2011-07-16 20:06:00 [6093]

Ez aztán a profi munka! Nagyon jó géped van ha ilyet csinálsz rajta, látszik érted a szakmát!

Előzmény: D.Laci, 2011-07-11 21:01:00 [6044]

Kinlódok vele még egy kicsit.

Előzmény: D.Laci, 2011-07-16 20:06:00 [6093]

Az a gebasz , hogy így nem tudom kiprobálni hisz nekem igyis müködik.
Próba cseresznye alapon deklaráld az A változót.

Előzmény: Miki2, 2011-07-16 19:33:00 [6092]

Ne haragudj, hogy még mindig ezen rágódok, és ezzel még mindig zavarlak.
A hiba a 28. sorba íródik.
Előtte a 27. sorban ez áll:

Private Function CalcYP(a, e, n, p)

A korábbi programrészben sehol nem találok utalást az " a " változóra.
Meg tudnád mondani, mire utal ez a változó, egyáltalán lehetséges, hogy emiatt akad ki?

Előzmény: D.Laci, 2011-07-13 21:22:00 [6090]

Na! D.Laci és Miki2! ezek már nagyon rejtjeles üzenetek!

Előzmény: D.Laci, 2011-07-13 21:22:00 [6090]

Atan2 vel is müködik, de ha nálad ez lenne a baj más hol is hibát jelezne.
Probáld ki.

Előzmény: Miki2, 2011-07-13 20:18:00 [6089]

Az ATan nem az ArcusTangens?
Merta fogaskerék programban a PI így van definiálva: pi=Atn(1)*4
Lehet, hogy csak valami elgépelés?

Előzmény: D.Laci, 2011-07-13 20:01:00 [6088]

Nem tom milehet a gebasz, nyilván valami nincs neked feltelepitve ami nekem felvan.

Előzmény: Miki2, 2011-07-13 16:51:00 [6087]

A fogaskerék szerkesztő tökéletesen működik.
A cikloid-nál ugyanaz a hibakód, mint a korábbi fájlnál.

Előzmény: D.Laci, 2011-07-13 06:42:00 [6086]

RH4 fogaskerékszerkesztő:


'Script by: Dorogi László
'RhinoScript version: 20090817
'Aug/17/2009

'Function List
' GearGen
' DoGetDefaults
' DoVersionCheck
' DoTell
' DoAskUser
' TiltedPoint
' CrossProduct
' xFormRotate
' InvCos
' InvSin
' DoAskString

'All functions (should) return a zero based array of at least (2) elements
'position 0 contains the result arrays/data (or Null on error)
'position 1 contains other arrays/data returned (or an error code on error)

Option Explicit

Sub Fogaskerekszerkeszto ()

Const version =20060906

'for the gear() array
Const PD =0 'Pitch diameter
Const PA =1 'Pressure angle
Const MDL =2 'Module
Const N =3 'Number of teeth
Const BC =4 'Base circle
Const ADD1 =5 'Addendum
Const DED =6 'Dedendum
Const OD =7 'Outside diameter
Const RD =8 'Root diameter
Const Tc =9 'Chordal thickness
Const CP =10 'Circular pitch
Const CA =11 'Cone angle
Const origin =12 'Pitch circle origin
Const smpl =13 'Involute point samples

Const Circle =0
Const show =7
Const summary =13

Const PDcircle =0
Const BCcircle =1
Const ODcircle =2
Const RDcircle =3

'for the Math() array
Const InvlstartAngle =1
Const InvlendAngle =2
Const InvlHeight =3
Const InvlHeightAngle =4
Const InvlAngleMod =5

'For the cplane() array
Const user =0 'Array of 3d points
Const temp =1 'Array of 3d points

'for the Dotell() array
Const success =0
Const fail =40

'Dim
Dim ask
Dim UserSays
Dim tell (40) 'Array
Dim gear
Dim default (20) 'Array
Dim Math (10) 'Array
Dim cplane (10) 'Array
Dim result (01)

Dim pi
Dim arrInvo 'An array of 3D points for the involute curve
Dim LoopOdo 'Loop counter (odometer)
Dim loopStep
Dim ObjectID
Dim TempID
Dim pointTemp
Dim point 'Miscelleneous "basket" for points

If DoVersionCheck(version)=False Then Exit Sub

'Data Harvest
ask=DoAskUser()
If IsNull(ask(0)) Then
Rhino.print ask(1)
Exit Sub
End If
gear=ask(0)
userSays=ask(1)
'<--

loopStep=0.1 'This defines the accuracy of the involute (needs to be automated some day... use the document tolerance values)
arrinvo=Array()
objectID=Array()
pi=Atn(1)*4

'-->obtain pitch-circle Cplane
cplane(user)=Rhino.viewcplane 'world coordinates defining cplane
cplane(temp)=Rhino.curveplane(userSays(Circle))
'<--End Obtain pitch-circle cplane

'gear(MDL)=gear(PD)/gear(N) defined earlier during user input
gear(BC)=gear(PD)*Cos(gear(PA)*pi/180)
gear(ADD1)=gear(MDL)
gear(DED)=1.157*gear(MDL) 'need to find the analytical method that generates this 1.157 value
gear(OD)=gear(PD)+2*gear(MDL)
gear(RD)=gear(PD)-2*gear(DED)
gear(tc)=gear(PD)*Sin((pi/2)/gear(N))

If (usersays(Show)(BCcircle)=vbTrue) Then Rhino.addcircle cplane(temp),gear(bc)/2 'consider asking user to include
If (usersays(Show)(ODcircle)=vbTrue) Then Rhino.addcircle cplane(temp),gear(od)/2 'consider asking user to include
If (usersays(Show)(RDcircle)=vbTrue) Then Rhino.addcircle cplane(temp),gear(RD)/2 'consider asking user to include
If (usersays(Show)(PDcircle)=vbTrue) Then
result(1)=Rhino.addcircle (cplane(temp),gear(PD)/2)
Rhino.selectObject result(1)
End If

'-->generate first involute
Math(InvlstartAngle)=(pi/2+invsin(gear(Tc)/gear(pd))) - (gear(PA)*pi/180) + Sqr((gear(PD)/gear(BC))^2-1)
Math(InvlEndAngle)=Math(invlStartAngle)-Sqr((gear(OD)/gear(bc))^2-1)
If (gear(RD)>Gear(BC)) Then Math(invlAngleMod)=Sqr((gear(rd)/gear(BC))^2-1) Else Math(invlAngleMod)=0
'Math(invlAngleMod)=0

'Prepare to use Cplane(temp) coordinates
gear(origin)=Rhino.xformworldtocplane(gear(origin),cplane(temp))

loopStep=(Math(InvlstartAngle)-Math(invlAngleMod)-Math(InvlendAngle))/gear(SMPL)
For loopodo=0 To gear(SMPL)
Math(invlHeight)=Sqr((loopodo*loopstep+Math(invlAngleMod))^2*(gear(bc)/2)^2+(gear(bc)/2)^2)
Math(InvlHeightAngle)=(math(invlstartAngle)-Math(invlAngleMod)-loopOdo*loopstep)+Atn((loopOdo*loopstep+Math(invlAngleMod)))
point=Array(gear(origin)(0)+Math(invlHeight)*Cos(Math(InvlHeightAngle)),Gear(origin)(1)+Math(invlHeight)*Sin(Math(InvlHeightAngle)),gear(origin)(2)+0)
Point=tiltedPoint(point,gear(CA),gear(PD))
point=Rhino.xformcplanetoworld (point,cplane(temp))
ReDim Preserve arrinvo(UBound(arrinvo)+1)
arrinvo(UBound(arrinvo))=point

Next
'<--End generate involute

'-->Generate gear profile
Rhino.EnableRedraw vbFalse
ReDim tempID(2)
'tempID(0)=rhino.addcurve (arrinvo) 'Do not use
tempID(0)=Rhino.addinterpcurveEx (arrinvo,3,1) 'Do not use the regular addInterpCurve

'mirror the first involute (the rhino.mirror command will not work in every orientation)
For loopOdo = 0 To UBound(arrinvo)
point=Rhino.xformworldtocplane (arrinvo(loopOdo),cplane(temp))
arrinvo(loopOdo)=Array(-point(0),point(1),point(2))
arrinvo(loopOdo)=Rhino.xformcplanetoworld (arrinvo(loopOdo),cplane(temp))
Next

'tempID(1)=rhino.addcurve (arrinvo) 'Do not use
tempID(1)=Rhino.addinterpcurveEx (arrinvo,3,1) 'Do not use the regular addInterpCurve

point=Array(gear(origin)(0),gear(OD)/2,gear(origin)(2))
PointTemp=tiltedPoint(point,gear(CA),gear(PD))
point=pointTemp
tempID(2)=Rhino.addarc3pt(Rhino.curveendpoint(tempID(0)),Rhino.curveendpoint(tempID(1)),Rhino.xformcplanetoworld (point,cplane(temp)))

'add line segments to the dedendum
If (gear(RD)<gear(BC)) Then
ReDim Preserve tempID(4)
point=Array(gear(origin)(0)+gear(RD)/2*Cos(math(invlstartangle)),gear(origin)(1)+gear(RD)/2*Sin(math(invlstartangle)),gear(origin)(2)+0)
Point=tiltedPoint(point,gear(CA),gear(PD))
point=Rhino.xformcplanetoworld (point,cplane(temp))
tempID(3)=Rhino.addline (Rhino.curvestartpoint(tempID(0)),point)

point=Array(gear(origin)(0)-gear(RD)/2*Cos(math(invlstartangle)),gear(origin)(1)+gear(RD)/2*Sin(math(invlstartangle)),gear(origin)(2)+0)
Point=tiltedPoint(point,gear(CA),gear(PD))
point=Rhino.xformcplanetoworld (point,cplane(temp))
tempID(4)=Rhino.addline (Rhino.curvestartpoint(tempID(1)),point)
End If

ReDim point(1)
objectID=Rhino.joincurves (tempID,vbTrue) 'returns an array of IDs (only the first is needed in this case)
tempID(0)=objectID
ReDim objectID(1)
objectID(0)=TempID(0)(0)
point(0)=Array(gear(origin)(0),gear(RD)/2,gear(origin)(2),cplane(temp))
point(0)=xformrotate(point(0),-pi/gear(N))
For loopOdo=1 To gear(N)
If (loopOdo<=gear(N)-1) Then
ReDim Preserve objectID(UBound(objectID)+2) 'in the beginning ObjectID only has the 0th element (each iteration adds two new object IDs)
objectID(UBound(objectID)-1)=Rhino.rotateobject (ObjectID(0),cplane(temp)(0),loopOdo*360/gear(N),(cplane(temp)(3)),vbTrue)
point(1)=xformrotate(point(0),loopOdo*pi*2/gear(N))
Point(1)=tiltedPoint(point(1),gear(CA),gear(PD))
point(1)=Rhino.xformcplanetoworld (point(1),cplane(temp))
objectID(UBound(objectID))=Rhino.addarc3pt (Rhino.curvestartpoint(objectID(UBound(objectID)-3)),Rhino.curveendpoint(objectID(UBound(objectID)-1)),point(1))
Else 'add the last arc element connecting the last tooth to the first tooth
point(1)=xformrotate(point(0),loopOdo*pi*2/gear(N))
Point(1)=tiltedPoint(point(1),gear(CA),gear(PD))
point(1)=Rhino.xformcplanetoworld (point(1),cplane(temp))
objectID(1)=Rhino.addarc3pt (Rhino.curveendpoint(objectID(0)),Rhino.curvestartpoint(objectID(UBound(objectID)-1)),point(1))
End If
Next
Rhino.EnableRedraw vbTrue
result(0)=Rhino.joincurves (objectID,vbTrue)(0)
Rhino.unselectobject usersays(circle)
Rhino.selectobject result(0)
'<--End generate gear profile

Rhino.print doTell(success)(0)
Rhino.print usersays(summary)

End Sub



'Receives
' -Nothing
'Returns
' -the default values for the <UserSays> array
Function DoGetDefaults(choice)

Const user =-3
Const generic =-2
Const every =-1

Const Circle =0
Const ManyTeeth =1
Const module =2
Const CircPitch =3
Const PressAngle =4
Const ConeAngle =5
Const Samples =6
Const show =7
Const angles =9
Const angleRange =10
Const bevelRange =11
Const samplesRange =12

Dim SuggestDefault (20)

If (choice=every Or choice=user Or choice=circle) Then _
SuggestDefault(circle)=Null

If (choice=every Or choice=user Or choice=manyTeeth) Then _
SuggestDefault(ManyTeeth)=13

If (choice=every Or choice=user Or choice=module) Then _
SuggestDefault(Module)=Null

If (choice=every Or choice=user Or choice=CircPitch) Then _
SuggestDefault(CircPitch)=Null

If (choice=every Or choice=user Or choice=PressAngle) Then _
SuggestDefault(PressAngle)=20

If (choice=every Or choice=user Or choice=ConeAngle) Then _
SuggestDefault(ConeAngle)=0

If (choice=every Or choice=user Or choice=Samples) Then _
SuggestDefault(Samples)=5

'[PDcircle,BCcircle,ODcircle,RDcircle]
If (choice=every Or choice=user Or choice=Show) Then _
SuggestDefault(Show)=Array(False,False,False,False)

'[PA1,minteeth,maxteeth],[PA2,minteeth,maxteeth],[PA3,minteeth,maxteeth]
If (choice=every Or choice=generic Or choice=angles) Then _
SuggestDefault(angles)=Array( Array(14.5,16,400), _
Array(20.0,13,400), _
Array(-1,7,400))

If (choice=every Or choice=generic Or choice=angleRange) Then _
SuggestDefault(angleRange)=Array(0,90)

If (choice=every Or choice=generic Or choice=bevelRange) Then _
SuggestDefault(bevelRange)=Array(0,90)

If (choice=every Or choice=generic Or choice=SamplesRange) Then _
SuggestDefault(SamplesRange)=Array(3,40)

If (choice=every Or choice=user Or choice=generic) _
Then DoGetDefaults=SuggestDefault Else DoGetDefaults=SuggestDefault(choice)

End Function



'Receives
' -Version number to check
'Returns
' -True or False if current version is newer (or the same).
Function DoVersionCheck(desiredVersion)

If (CLng(Rhino.Version) < CLng(desiredVersion)) Then
Rhino.print DoTell(40)(0)&DoTell(41)(0)&" <"&CLng(desiredVersion)&"> "&DoTell(41)(1)&"("&DoTell(41)(2)&Rhino.Version&")."
DoVersionCheck=False
Else
Rhino.print DoTell(22)(0)&" "&Rhino.Version
DoVersionCheck=True
End If

End Function



'Receives
' -an integer
'Returns
' -an array of strings
'(messages are thematically grouped)
Function DoTell(what)
Dim Say(80)

'Messages
Say(00)=Array("Script completed successfully.")
Say(01)=Array("Fogakszáma", "Modul", "Fogtáv", "PressAngle", "Szög", "Pontosság")
Say(02)=Array("Menű", _
"Osztókör kiválasztása ", _
"Fogakszáma", _
"Modul=", _
"Fogtáv=", _
"Choose the pressure angle (14.5 or 20.0 degrees)", _
"Pitch Cone Angle=", _
"Pontosság", _
"Maintain:")
Say(03)=Array("Choice of zero (0) angle for spur gear. Choices other than zero (0) will result bevel gear profiles", _
"Recommend for 14.5 degree pressure angle: min 16 teeth with at least 40 teeth in a meshing pair", _
"Recommend for 20 degree pressure angle: min 13 teeth with at least 26 teeth in a meshing pair", _
"Metrikus fogaskerék szerkesztő")
Say(04)=Array("New module number required slight adjustment of pitch diameter.", _
"New circular pitch required slight adjustment of pitch diameter.", _
"Both options will affect the pitch diameter. The pitch-circle option will choose a diameter close to the original.")
Say(05)=Array("Pitch Diameter=", "Adjusted ", "Base circle diameter=", "Root circle diameter=", "Outside diameter=", _
"Module range for the given Pitch Circle: <"," to ",">", _
"Pitch range for the given Pitch Circle: <", "Summary:")
Say(06)=Array("Fogtáv", "Fogakszáma")
Say(07)=Array("Osztókör átmérő=", "Fogak száma=","Modul=","Fogtáv=","Pressure Angle=","Cone Angle=","Pontosság=")

'Internal Errors (debug session)
Say(20)=Array("Requested error string ("&what&") not found for display. ",1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20)
Say(21)=Array("Internal error. ","Prerequisites not met for the ","function")
Say(22)=Array("Installed version of RhinoScript is accepted. Version found:")

'User abort/error
Say(40)=Array("Script not successful. ","Script aborted. ")
Say(41)=Array("Please update to RhinoScript","or later. ","Version found: ")
Say(42)=Array("(Custom pressure angles not supported at this time)", _
"(No pitch circle selected)", _
"(Selected object was not a circle)", _
"(Invalid input for pressure angle)", _
"(Invalid input for number of teeth)", _
"(Minimum number of teeth requirement not met)", _
"(Invalid input for point samples)", _
"(Invalid input for module number)", _
"(Invalid input for Cone Angle)", _
"(Invalid Input)")

If (UBound(Say)<what Or LBound(Say)>what ) Then
doTell=Say(20)
Exit Function
ElseIf VarType(Say(what))<8000 Then
doTell=Say(20)
Exit Function
End If

DoTell=Say(what)
End Function



'Receives
' -Nothing
'Returns
' -an array (gear info)
' -an array (userSays)
Function DoAskUser ()

'For the userSays() array
Const Circle =0
Const ManyTeeth =1
Const module =2
Const CircPitch =3
Const PressAngle =4
Const ConeAngle =5
Const Samples =6
Const show =7
Const angles =9
Const angleRange =10
Const bevelRange =11
Const samplesRange =12
Const summary =13

Const PDcircle =0
Const BCcircle =1
Const ODcircle =2
Const RDcircle =3

'for the gear() array
Const PD =0 'Pitch diameter
Const PA =1 'Pressure angle
Const MDL =2 'Module
Const N =3 'Number of teeth
Const BC =4 'Base circle
Const ADD1 =5 'Addendum
Const DED =6 'Dedendum
Const OD =7 'Outside diameter
Const RD =8 'Root diameter
Const Tc =9 'Chordal thickness
Const CP =10 'Circular pitch
Const CA =11 'Cone angle
Const origin =12 'Pitch circle origin
Const smpl =13 'Involute point samples

Const min =0
Const max =1

Const user =-3
Const generic =-2
Const every =-1

Const Fail =40
Const mainMenu =01

'Dim
Dim pi
Dim temp
Dim Default
Dim options
Dim valueRange
Dim UserSays
Dim toReturn
Dim OneResponse

UserSays=DoGetDefaults(user)
pi=Atn(1)*4

ReDim temp(20)
ToReturn=Array(0,0)
ToReturn(0)=temp
ValueRange=Array(0,0)

'-->Start user section
'Input pitch diameter
Rhino.print DoTell(3)(3)
UserSays(Circle)=Rhino.GetObject(DoTell(2)(1),4,vbTrue,vbFalse)
If IsNull(UserSays(Circle)) Then
ToReturn(0)=Null
ToReturn(1)=DoTell(Fail)(0)&DoTell(42)(1)
DoAskUser=toReturn
Exit Function
ElseIf (Not Rhino.iscircle(UserSays(Circle))) Then
ToReturn(0)=Null
Rhino.print DoTell(Fail)(0)&DoTell(42)(2)
DoAskUser=toReturn
Exit Function
End If

toReturn(0)(origin) =Rhino.circlecenterpoint(UserSays(Circle))
toReturn(0)(PD) =Rhino.circleradius(UserSays(Circle))*2
userSays(module) =toReturn(0)(PD)/UserSays(ManyTeeth)
userSays(CircPitch) =pi*toReturn(0)(PD)/UserSays(ManyTeeth)
toReturn(0)(CP) =UserSays(CircPitch)
toReturn(0)(MDL) =UserSays(Module)
toReturn(0)(PA) =usersays(PressAngle)
toReturn(0)(N) =UserSays(ManyTeeth)
toReturn(0)(CA) =usersays(coneAngle)
toReturn(0)(SMPL) =userSays(samples)

Do
If usersays(show)(PDcircle)=True Then temp=doTell(5)(1) Else temp=""

usersays(summary)= doTell(5)(9)&"["&temp&doTell(07)(0)&Round(toReturn(0)(PD),3)&"] ["& _
doTell(07)(1)&toReturn(0)(N)&"] ["&doTell(07)(2)&Round(toReturn(0)(MDL),3)&"] ["& _
doTell(07)(3)&Round(toReturn(0)(CP),3)&"] ["& _
doTell(07)(4)&Round(toReturn(0)(PA),3)&"] ["& _
doTell(07)(5)&Round(toReturn(0)(CA),3)&"] ["& _
doTell(07)(6)&toReturn(0)(smpl)&"]"
Rhino.print usersays(summary)

default=""
options=DoTell(01)
OneResponse=Array("","")
oneResponse(0)=Rhino.getstring(DoTell(02)(0),Default,Options) 'Main menu
oneResponse(0)=LCase(oneresponse(0))
Select Case oneResponse(0)
Case LCase (DoTell(MainMenu)(0)) 'Teeth
ValueRange(min)=DoGetDefaults(angles)(2)(1)
ValueRange(max)=DoGetDefaults(angles)(2)(2)
If usersays(pressangle)=DoGetDefaults(Angles)(0)(0) Then Rhino.print Dotell(03)(1) Else Rhino.print Dotell(03)(2)
Default=userSays(ManyTeeth)
oneResponse(0)=Rhino.GetInteger(DoTell(2)(2),Default,ValueRange(min),ValueRange(max))
If IsNull(oneResponse(0)) Then Exit Do
userSays(ManyTeeth)=oneResponse(0)
toReturn(0)(N) =UserSays(ManyTeeth)
toReturn(0)(MDL)=toReturn(0)(PD)/toReturn(0)(N)
toReturn(0)(CP)=pi*toReturn(0)(PD)/toReturn(0)(N)
UserSays(Module)=toReturn(0)(MDL)
UserSays(CircPitch)=toReturn(0)(CP)
Case LCase (DoTell(MainMenu)(1)) 'Module
ValueRange(min)=toReturn(0)(PD)/DoGetDefaults(angles)(2)(2)
ValueRange(max)=toReturn(0)(PD)/DoGetDefaults(angles)(2)(1)
Default=usersays(module)
If IsNull(default) Then Default=ValueRange(max)
Rhino.print DoTell(5)(5)&Round(ValueRange(min),4)&DoTell(5)(6)&Round(ValueRange(max),4)&DoTell(5)(7)
oneResponse(0)=Rhino.GetReal (DoTell(2)(3),Default,valueRange(min),ValueRange(max))
If IsNull(oneResponse(0)) Then Exit Do
userSays(Module)=oneResponse(0)
default=DoTell(06)(1)
options=DoTell(06)
Rhino.print doTell(04)(2)
oneResponse=DoAskString(DoTell(2)(8),default,options,True)
If IsNull(oneResponse(0)) Then Exit Do
toReturn(0)(MDL)=UserSays(Module)
If (oneResponse(0)=options(0)) Then 'pitchCircle
toReturn(0)(N)=toReturn(0)(PD)/toReturn(0)(MDL)
If (Int(toReturn(0)(N))<>toReturn(0)(N)) Then
toReturn(0)(N)=CInt(toReturn(0)(N))
toReturn(0)(PD)=toReturn(0)(N)*toReturn(0)(MDL)
Rhino.print DoTell(4)(0)&" "&DoTell(5)(1)&DoTell(5)(0)&Round(toReturn(0)(PD),4)
userSays(Show)(PDcircle)=vbTrue
End If
ElseIf (oneResponse(0)=options(1)) Then 'teethNumber
toReturn(0)(PD)=toReturn(0)(N)*toReturn(0)(MDL)
Rhino.print DoTell(5)(1)&DoTell(5)(0)&Round(toReturn(0)(PD),4)
userSays(Show)(PDcircle)=vbTrue
End If
toReturn(0)(CP)=pi*toReturn(0)(PD)/toReturn(0)(N)
userSays(manyTeeth)=toReturn(0)(N)
userSays(CircPitch)=toReturn(0)(CP)
Case LCase (DoTell(MainMenu)(2)) 'Pitch
ValueRange(min)=pi*toReturn(0)(PD)/DoGetDefaults(angles)(2)(2)
ValueRange(max)=pi*toReturn(0)(PD)/DoGetDefaults(angles)(2)(1)
Default=usersays(CircPitch)
If IsNull(default) Then Default=ValueRange(max)
Rhino.print DoTell(5)(8)&Round(ValueRange(min),4)&DoTell(5)(6)&Round(ValueRange(max),4)&DoTell(5)(7)
oneResponse(0)=Rhino.GetReal (DoTell(2)(4),Default,valueRange(min),ValueRange(max))
If IsNull(oneResponse(0)) Then Exit Do
userSays(CircPitch)=oneResponse(0)
default=DoTell(06)(1)
options=DoTell(06)
Rhino.print doTell(04)(2)
oneResponse=DoAskString(DoTell(2)(8),default,options,True)
If IsNull(oneResponse(0)) Then Exit Do
toReturn(0)(CP)=UserSays(CircPitch)
If (oneResponse(0)=options(0)) Then 'pitchCircle
toReturn(0)(N)=pi*toReturn(0)(PD)/toReturn(0)(CP)
If (Int(toReturn(0)(N))<>toReturn(0)(N)) Then
toReturn(0)(N)=CInt(toReturn(0)(N))
toReturn(0)(PD)=toReturn(0)(N)*toReturn(0)(CP)/pi
Rhino.print DoTell(4)(1)&" "&DoTell(5)(1)&DoTell(5)(0)&Round(toReturn(0)(PD),4)
userSays(Show)(PDcircle)=vbTrue
End If
userSays(manyTeeth)=toReturn(0)(N)
ElseIf (oneResponse(0)=options(1)) Then 'teethNumber
toReturn(0)(PD)=toReturn(0)(N)*toReturn(0)(CP)/pi
Rhino.print DoTell(5)(1)&DoTell(5)(0)&Round(toReturn(0)(PD),4)
userSays(Show)(PDcircle)=vbTrue
End If
toReturn(0)(MDL)=toReturn(0)(PD)/toReturn(0)(N)
userSays(manyTeeth)=toReturn(0)(N)
userSays(Module)=toReturn(0)(MDL)
Case LCase (DoTell(MainMenu)(3)) 'PressAngle
ValueRange(min)=DoGetDefaults(angleRange)(min)
ValueRange(max)=DoGetDefaults(angleRange)(max)
Default=usersays(PressAngle)
oneResponse(0)=Rhino.getReal(DoTell(2)(5),Default,valueRange(min),ValueRange(Max))
If IsNull(oneResponse(0)) Then Exit Do
If (oneResponse(0)<>DoGetDefaults(angles)(0)(0) And oneResponse(0)<>DoGetDefaults(angles)(1)(0)) Then
oneResponse(0)=Null
oneResponse(1)=doTell(42)(0)
Exit Do
End If
userSays(PressAngle)=oneResponse(0)
toReturn(0)(PA)=usersays(PressAngle)
Case LCase (DoTell(MainMenu)(4)) 'Bevel
ValueRange(min)=DoGetDefaults(bevelRange)(min)
ValueRange(max)=DoGetDefaults(bevelRange)(max)
Default=usersays(ConeAngle)
Rhino.print DoTell(03)(0)
oneResponse(0)=Rhino.getReal(DoTell(2)(6),Default,valueRange(min),ValueRange(Max))
If IsNull(oneResponse(0)) Then Exit Do
usersays(coneAngle)=oneResponse(0)
toReturn(0)(CA)=usersays(coneAngle)
Case LCase (DoTell(MainMenu)(5)) 'Accuracy
ValueRange(min)=DoGetDefaults(samplesRange)(min)
ValueRange(max)=DoGetDefaults(samplesRange)(max)
Default=usersays(samples)
oneResponse(0)=Rhino.getInteger(DoTell(2)(7),Default,valueRange(min),ValueRange(Max))
If IsNull(oneResponse(0)) Then Exit Do
usersays(samples)=oneResponse(0)
toReturn(0)(smpl)=usersays(samples)
Case Else
'Do nothing
End Select

Loop While (oneResponse(0)<>"" And (Not IsNull(oneresponse(0))) )

If (IsNull (oneresponse(0))) Then
toReturn(0)=Null
toReturn(1)= DoTell(40)(1)&oneresponse(1)
DoAskUser=toReturn
Exit Function
End If

toReturn(0)(BC) =toReturn(0)(PD)*Cos(toReturn(0)(PA)*pi/180)
toReturn(0)(ADD1) =toReturn(0)(MDL)
toReturn(0)(DED) =1.157*toReturn(0)(MDL) 'need to find the analytical method that generates this 1.157 value
toReturn(0)(OD) =toReturn(0)(PD)+2*toReturn(0)(MDL)
toReturn(0)(RD) =toReturn(0)(PD)-2*toReturn(0)(DED)
toReturn(0)(tc) =toReturn(0)(PD)*Sin((pi/2)/toReturn(0)(N))
toReturn(1) =userSays
DoAskUser=toReturn
End Function



'Receives
' -a 3D point
' -a real: the cone angle (in degrees)
' -a real: the pitch diameter
'Returns
' -a 3D point adjusted
'origin is assumed to be 0,0,0
Function TiltedPoint(OldPoint,coneAngle, PD)
Const x =0
Const y =1
Const z =2

Dim NewPoint (2)
Dim delta(1)
Dim pi
Dim epsilon

If coneAngle=0 Then
TiltedPoint=oldPoint
Exit Function
End If
epsilon=Rhino.unitabsolutetolerance
pi=Atn(1)*4

delta(1)=Sqr(OldPoint(x)^2+OldPoint(y)^2)-(PD/2)
NewPoint(z)=delta(1)*Sin(ConeAngle*pi/180)
delta(0)=delta(1)*Cos(ConeAngle*pi/180)
NewPoint(x)=(PD/2+delta(0))/(PD/2+delta(1))*OldPoint(x)
NewPoint(y)=(PD/2+delta(0))/(PD/2+delta(1))*OldPoint(y)

TiltedPoint=NewPoint
End Function



Function xFormRotate(ThisPoint,Angle)
Dim TempPoint
If (IsArray(ThisPoint) And angle<>vbNull) Then
tempPoint=Array(thispoint(0)*Cos(angle)-thispoint(1)*Sin(angle),thispoint(0)*Sin(angle)+thispoint(1)*Cos(angle),0)
xFormRotate=tempPoint
Else
xformrotate=vbNull
End If
End Function



Function InvCos (x)
Dim pi
pi=Atn(1)*4
If (x<>1 And x<>-1) Then InvCos=Atn(-X / Sqr(-(X^2) + 1)) + 2 * Atn(1)
If (x=1) Then InvCos=0
If (x=-1) Then InvCos=pi
End Function



Function InvSin (x)
Dim pi
pi=Atn(1)*4
If (x<>1 And x<>-1) Then InvSin=Atn(X / Sqr(-(X^2) + 1))
If (x=1) Then InvSin=pi/2
If (x=-1) Then InvSin=-pi/2
End Function



'Receives
' -a string (prompt)
' -a string (default value)
' -an array of strings (clickable options)
' -a boolean (on true, repeat asking user if input was invalid
'Returns
' -a string (user response) or null if user aborted
Function DoAskString (Prompt,default,options,loopifinvalid)
Dim toReturn
Dim Prerequisites
Dim Loopodo,howmany
Dim ready

'->Check Prerequisites
If (VarType(prompt)<>8 Or VarType(default)<>8 Or VarType(options)<8000 Or VarType(loopIfInvalid)<>11) Then
toReturn(0)=Null
toReturn(1)=DoTell(21)(1)&"DoAskString"&DoTell(21)(2)
End If
'<--

toReturn=Array(0,0)
howmany=UBound(options)
ready=False

Do
toReturn(0)=Rhino.getString(Prompt,default,options)
For loopodo=0 To howmany
If LCase(toReturn(0))=LCase(options(loopodo)) Then ready=True
Next
If (loopIfInvalid=False And ready=False) Then
toReturn(0)=Null
toReturn(1)=DoTell(42)(9)
ready=True
ElseIf (loopIfInvalid=True And ready=False And (Not IsNull(toReturn(0)))) Then
Rhino.print DoTell(42)(9)
End If
Loop While (ready=False And (Not IsNull(toReturn(0))))

DoAskString=toReturn
End Function

Valószinü hiányzik valami de nem tom hogy mi.


probáld ki ezt:

Option Explicit

Sub Hypocycloidszerkeszto()
Dim p, b, d, e, n
b = Rhino.GetReal ("Osztókör átmérője")
d = Rhino.GetReal ("Csapok átmérője")
e = Rhino.GetReal ("Excentricitás")
n = Rhino.GetInteger ("Fogak száma")
p = (b/2)/n

Dim i, arrPoint, arrPoints(360)
For i = 0 To 360
arrPoint = Array(CalcX(p,d,e,n,Rhino.ToRadians(i)), CalcY(p,d,e,n,Rhino.ToRadians(i)), 0)
arrPoints(i) = arrPoint
Next
Rhino.AddInterpCurve(arrPoints)

Dim xtemp, ytemp
For i = 0 To n+1
xtemp = p*n*Cos(2*Rhino.pi/(n+1)*i)
ytemp = p*n*Sin(2*Rhino.pi/(n+1)*i)
arrPoint = Array(xtemp+e, ytemp, 0)
Rhino.AddPoint(arrPoint)
Next
End Sub

Private Function CalcYP(a, e, n, p)
CalcYP = Rhino.ATan2(Sin(n*a)/(Cos(n*a)+(n*p)/(e*(n+1))), 1.0)
End Function

Private Function CalcX(p,d,e,n,a)
CalcX = (n*p)*Cos(a)+e*Cos((n+1)*a)-d/2*Cos(CalcYP(a,e,n,p)+a)
End Function

Private Function CalcY(p,d,e,n,a)
CalcY = (n*p)*Sin(a)+e*Sin((n+1)*a)-d/2*Sin(CalcYP(a,e,n,p)+a)
End Function


elvileg ugyan az csak magyar

Előzmény: Miki2, 2011-07-12 21:55:00 [6084]

Nem kell valami külön értelmező interpreter, vagy valami kiegészítő az XP-hez?
Lehet az XP hiányol valamit, csak titkolja.

Előzmény: D.Laci, 2011-07-12 21:49:00 [6083]

Nekem ez igy működik.

Előzmény: Miki2, 2011-07-12 21:04:00 [6082]

Bocs, hogy okvetetlenkedek.
A 28. sornál hibaüzenettel leáll. Ezt tartalmazza.
CalcYP = Rhino.ATan2(Sin(n*a)/(Cos(n*a)+(n*p)/(e*(n+1))), 1.0)

A kiírt üzenet a következő:

Source: Microsoft VBScript futásidejű hiba
Error: Az objektun nem támogatja ezt a tulajdonságot, vagy metódust
Rhino.ATan2'
Line: 28
Char: 0
Code: 0

Sajnos nem tudok rájönni, mi lehet az oka.
A netről letöltött változatban ugyanez volt a hibaüzenet.
Amit Te küldtél vagy két évvel ezelőtt, az rendesen működött.
Ezért bátorkodtam megint Tőled kérni.

Előzmény: D.Laci, 2011-07-12 18:46:00 [6081]

Option Explicit

Sub Hypocycloid()
Dim p, b, d, e, n
b = Rhino.GetReal ("Pin circle diameter")
d = Rhino.GetReal ("Pin diameter")
e = Rhino.GetReal ("Eccentricity")
n = Rhino.GetInteger ("Number of teeth")
p = (b/2)/n

Dim i, arrPoint, arrPoints(360)
For i = 0 To 360
arrPoint = Array(CalcX(p,d,e,n,Rhino.ToRadians(i)), CalcY(p,d,e,n,Rhino.ToRadians(i)), 0)
arrPoints(i) = arrPoint
Next
Rhino.AddInterpCurve(arrPoints)

Dim xtemp, ytemp
For i = 0 To n+1
xtemp = p*n*Cos(2*Rhino.pi/(n+1)*i)
ytemp = p*n*Sin(2*Rhino.pi/(n+1)*i)
arrPoint = Array(xtemp+e, ytemp, 0)
Rhino.AddPoint(arrPoint)
Next
End Sub

Private Function CalcYP(a, e, n, p)
CalcYP = Rhino.ATan2(Sin(n*a)/(Cos(n*a)+(n*p)/(e*(n+1))), 1.0)
End Function

Private Function CalcX(p,d,e,n,a)
CalcX = (n*p)*Cos(a)+e*Cos((n+1)*a)-d/2*Cos(CalcYP(a,e,n,p)+a)
End Function

Private Function CalcY(p,d,e,n,a)
CalcY = (n*p)*Sin(a)+e*Sin((n+1)*a)-d/2*Sin(CalcYP(a,e,n,p)+a)
End Function






ez a cycloid fájl rh4 skript editorába másold be aztán mentsd el.

Köszönöm a választ.
A propó cikloid.
El tudnád nekem még egyszer küldeni a fogaskerék, és a cikloid szerkesztő plugint a Rhino-hoz?
Köszönöm.

Előzmény: D.Laci, 2011-07-12 14:06:00 [6078]

Köszönöm kérdésed! Semmi különös, első a munkahely, talán ami a leginkább CNC-hez köthető, hogy gyerekeket utaztatok lin-vezetéken. (Hinta helyett) De ha már én is fel tudok valami szakmai dolgot mutatni, meg fogom tenni.

Előzmény: D.Laci, 2011-07-12 11:22:00 [6076]

Egy mezei 1,5Kw-os AC motor és egy 50W-os szervó motor cikloid hajtással. Fogas szíjat könyen tudom cserélni. de lehet lecserélem egy nagy AC szervóra...

Előzmény: Miki2, 2011-07-12 13:02:00 [6077]

Gratulálok, nagyon szép munka.
Laci! Milyen meghajtó motorod van az esztergán, amit "C" tengely, és főorsó üzemmódra is alkalmas?

Előzmény: D.Laci, 2011-07-11 21:01:00 [6044]

Laslie: Ha minden jól megy megy a posta!
Nemes János: köszi, te is páratlan reliefeket marsz.
Molinari: Mostanában ritkán látni téged! Mit remekelsz mostanában?

Ez igen!
Elfér a polcon még egy gratuláció?
Akkor azt én küldöm!

Előzmény: D.Laci, 2011-07-11 21:01:00 [6044]

Nagyon profi!

Előzmény: D.Laci, 2011-07-11 21:01:00 [6044]

Csak küldje-küldje....
Minden olyan érdekel ami nem olyan, mint amilyen.

Előzmény: D.Laci, 2011-07-12 09:18:00 [6072]

Valami alu.
Megprobálok beszélni a srácal hogy küldje el neked a darabot, megsasolás címén. Több szem többet lát. Tanulságos lehet mindenkinek.

Előzmény: Laslie, 2011-07-12 09:14:00 [6071]

Csakhogy az nem szabványos emelkedés.
Műanyag volt az eredeti ?

Előzmény: D.Laci, 2011-07-12 09:10:00 [6070]

Azzal kezdtem énis.
Már a menet fésűimet is kidobtam mert nem paszolt egyiksem...
Nagyából kimértem, és ezredenként változtattam a menet emelkedést így kijött az 1.076mm emelkedés ami tökéletesenpaszolt.

Előzmény: Laslie, 2011-07-12 09:05:00 [6069]

Ez biztosan nem jó adat.
24 menet lesz az...

Előzmény: D.Laci, 2011-07-12 09:00:00 [6067]

Akkor más lehetőség nincs, mint M35x1-es menet lesz az. Több variációt nem ismerek.

Előzmény: D.Laci, 2011-07-12 08:54:00 [6066]

De ne találgasunk tovább 1.076mm a menet emelkedés...

"A táblázatok is erösen hibásak. A linkelt táblázatban 1" esetén 24.3-24.4mm átméröt admeg. "
Ezt észre vettem hogy hülyeséget írtam ki is töröltem, de hogy maradt bene???
Kár hogy nem lehet utolag javittani.
Nem 24tpi-s a menet...

Előzmény: Laslie, 2011-07-12 08:40:00 [6065]

Basszus, a táblázatnak semmi baja nincs, csak az a 24,3 és a 24,4 a magfuratra vonatkozik nem a külső átmérőre.
24,3 az 1"-os külső és 24menetes emelkedés, a 24,4 pedig az 1"-os külső és 26menetes emelkedés.

A keresett meneted pedig nagy valószínűséggel az FG34,8-24.
Az átmérőt megesztergálod 34,7-re, majd egy hegyes 60 fokos késsel átmérőben lemész 1,2mm-t, 24 menet/coll emelkedés mellett.

Előzmény: D.Laci, 2011-07-12 06:36:00 [6063]

Csak ne szerénykedj! Nagy mágus vagy Te Barátom!

Előzmény: D.Laci, 2011-07-11 21:48:00 [6055]

Az átmérő 1.370"
Menetemelkedés azt nem mondom meg
Másfél napot szoptam vele netet bujtam idom szereket csináltam mire kijött a megfelelő menet emelkedés... valszeg a hagyományos gépen nem is lehet olyan menet emelkedést vágni.

BSC Menetek ezekre gondolsz?

A táblázatok is erösen hibásak. A linkelt táblázatban 1" esetén 24.3-24.4mm átméröt admeg.
1 3/8" esetén átváltja decimális értékre 1.370" ra, amit ha kiszámolunk 1 3/8" = 34.925mm , 1.370" = 34.798mm , aza ~0.13mm átméröben kurva sok.... na a menetben is ekora szorás van 3-4 menetnél nem számit. Szerencsére ~15-16mm hosszú menet mintát kaptam ott rögtön elő jött a gebasz...

Előzmény: Laslie, 2011-07-11 22:38:00 [6059]

Biztos van összefüggés a tudás,és a tej között.

Valaki mondta,... "A tudás,az hatalom".
Ebből kifolyólag Te,biztos tejbe-vajba fürdesz.
Már-ha,tejelnek a kuncsaftok rendesen.:))

Előzmény: Laslie, 2011-07-11 23:15:00 [6061]

Én mondtam, hogy a tudás a tejben van...

Előzmény: KoLa, 2011-07-11 22:59:00 [6060]

Há' ezért maradok én csak egy rossz esztergályos!

Előzmény: Laslie, 2011-07-11 22:38:00 [6059]

Te meg kinevetted....
Oszt tényleg az !

BSC = British Standard Cycle

Előzmény: KoLa, 2011-07-11 22:29:00 [6058]

Nálunk régen a GySGy ben volt egy mérnök aki azt mondta ilyen esetben, hogy, ez biciklimenet!

Előzmény: Laslie, 2011-07-11 22:16:00 [6057]

Mekkora átmérőt és mekkora menetemelkedést mérsz ?

Előzmény: D.Laci, 2011-07-11 21:41:00 [6053]

Ok Laci!várjuk a fejleményeket! ha van valami siker élményed csak oszd meg itt nekünk nyugodtan! mer az ilyen sikerek, növelik az elszántságot a társaságban!

Előzmény: D.Laci, 2011-07-11 21:48:00 [6055]

Kevés az még... amim van..
"Aki tudja csinálja, aki nem tudja, tanítja"
Figyelem a fejleményeket. Ha valamit észre veszek szólok.

Előzmény: KoLa, 2011-07-11 21:40:00 [6052]

Van foga?
Van hát!
Ne kötekedj!
:)
Amikor elkészült annyira tökéletes let hogy egésznap azon gondolkodtam, mit kelenne elbaszni rajta... Hát igy let belőle fogas kerék

Előzmény: PSoft, 2011-07-11 21:24:00 [6048]

A tudás bűn!!
Én ártatlan vagyok!!
Hamár ide vetödtél teis.
Légy oly kedves segits ki azzal hogy a hátsó agynál alkalmazott 7 szabvány menet méreteit megadod.
Mit össze görcsöltem mire kisakkoztam milyen menet volt az eredetin. A neten anyit találtam, hogy 7 szabvány tipust alkalmaznak, ezt tuti nem szabvány...

Előzmény: Laslie, 2011-07-11 21:16:00 [6047]

Beszállhatnál a 'honosításba' a gyakorlati tudásoddal!

Előzmény: D.Laci, 2011-07-11 21:36:00 [6050]

KLassz!

Előzmény: D.Laci, 2011-07-11 21:01:00 [6044]

Igen EMC2-vel készült.

Előzmény: KoLa, 2011-07-11 21:09:00 [6046]