Ezt készítettem a CNC gépemmel...

[may47wb]

Nagyon profi![#eljen]

[000000000]

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

[D.Laci]

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?

[Miki2]

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

[D.Laci]

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...

[000000000]

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.

[Miki2]

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.

[D.Laci]

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.

[Miki2]

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.

[D.Laci]

Nekem ez igy működik.

[Miki2]

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

[D.Laci]

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

[D.Laci]

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)(,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)(&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)(,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
 
 

[Miki2]

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.

[D.Laci]

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