Eddig még nem találtam drágább márkát a piacon.
Bár jobbat sem.
(40-45% a kedvezményünk a listaárból.)

Előzmény: svejk, 2011-07-24 19:09:00 [6128]

El kell mondjam, hogy utálom a savállót, de szép!
Gratulálok a munkádhoz!!

Nagyon jók!

Előzmény: Béni, 2011-07-24 15:55:00 [6123]

Rákeresve, találomra 92 Euró.
De szépen vitte az biztos

Előzmény: Béni, 2011-07-24 18:11:00 [6126]

Köszönöm!

Előzmény: Törölt felhasználó, 2011-07-24 16:39:00 [6125]

8-as Prototyp (Walter) saroktörővel készült.
(Nem erre találták ki, de viszonylag jól működött.)
2500-ös fordulat (ez volt a max. az adott gépen), 1.3 mm maximális mélység, 200 mm/perc előtolás, minimálkenés.

Előzmény: Fman, 2011-07-24 16:20:00 [6124]

Ezek, szép, és jól kivitezett munkák!
Gratulálok!

Előzmény: Béni, 2011-07-24 15:55:00 [6123]

Szia Béni!
Nagyon szép lett mindkét munka!Gratula!
A bilétában különösen tetszik a szép mély gravírozás.
A rozsdamentes anyagokkal mindig megszenvedek.
Milyen szerszámmal és milyen forgácsolási adatokkal sikerült ilyen szépre?

Előzmény: Béni, 2011-07-24 15:36:00 [6122]

A nagyobbik fiú tervei alapján készült az alábbi falióra. (Egyelőre polcon.)


A gravírozás egy törött M12-as gépi menetfúróból kézben köszörült Vbit szerszámmal:


Kivágás 6-os egyélűvel:


Jól láthatóak a kivágásnál az elmozdulást gátló hidak:

Festés:


Gárdaoroszlán közelebbről:

A kisebbik fiamnak készítettem egy "nyakbavalót".
Anyaga 2mm-es saválló lemez, 35 mm széles. Polírozva még nincs, csak 120-as vászonnal csiszoltam. (A csalóka szín a megvilágítástól van.)

ÚÚ na az már túl messze van nekem. Azért köszi.

Előzmény: forgácsolo, 2011-07-23 16:38:00 [6120]

ha kell akár ingyen is megtudnám csinálni csak szerintem sok lenne a szállítási költség kb (€50) és az idő. így neked nem biztos hogy megéri.

+353 86 2195647 (Irország)
sajna a Magyar lejárt, már több mit 8 éve itt élek

Előzmény: Gyárfás Attila, 2011-07-22 12:47:00 [6118]

Szia
Látom fával dolgozol. Esetleg ebben nem tudnál segíteni?
Kép
Ez va, csak le van festve. Mérete kb. H:350mm. 2db kellene belőle. Van rendes m.rajzom róla.
Lenne egy másik dolog is, amit viszont telefonon szeretnék elmondani, így megköszönném ha megadnád a számod.
Köszi

Előzmény: forgácsolo, 2011-07-22 00:58:00 [6115]

köszi

aki a rajzokat készítette az-é a dicséret én csak kimartam igaz nekem kicsit újnak számít mert ilyen kaliberű munkát még nem csináltam eddig többnyire 20as átmérőjű szerszámokkal dolgoztam és 20mm mély anyagátvágásokat csináltam egy lépcsőben 2500-as sebességgel, ezek a puzzle-k kissé más technikát igényel de egy kis gyakorlás után ezt is ki lehet tapasztalni.

Nagyon tetszenek a munkáid!! Gratula!!

Előzmény: forgácsolo, 2011-07-21 23:33:00 [6111]

ez is ajándékba készült de amikor elkezdtem akkor még nem tudtam hogy ajándék lesz, egy barátomnak megtetszett és nekiadtam, később kiderült hogy nagy modell gyűjtő.

szívesen elküldöm térítésmentesen, nekem nem ez a fő profilom, ebből nem lehet meggazdagodni sőt szerintem megélni sem egyébként én úgy cseréltem ezeket és még ezenkívül kaptam még sok jó dolgot, szívesen segítek mindenkinek ha tudok. felraknám ide is de nem tudom hogy kell.


küldöm a DXF-et

Előzmény: Törölt felhasználó, 2011-07-22 00:13:00 [6113]

Az a helikopter nekem nagyon tetszik esetleg nem eladó vagy a dxf-jét nem lehetne-e megvenni?Mert nemsokára lesz egy helikopter pilóta ismerősöm születésnapja és neki szeretném ajándékba.Amíg nincs ár addig ne küldd el légy szíves a dxf-et,mert vannak itt a fórumon olyan emberek akik elküldik anélkül,hogy megkérdeznék,h ennyiért kell-e aztán meg követelik a pénzt.
Előre is köszönöm.

Előzmény: forgácsolo, 2011-07-21 23:33:00 [6111]

https://picasaweb.google.com/irsanyi69/CNCPuzzleMunkaim2011?authuser=0&authkey=Gv1sRgCMvGq72t1vb9Ag&feat=directlink

Én nekem is van egy ilyenem.

Előzmény: PSoft, 2011-07-17 19:19:00 [6109]

Köszönöm,de az ötlet Attiláé,és "csapatáé".:)
Őt(őket) illeti a dícséret az igazán profi kivitelért.

Én,csak a plexit vágtam hozzá.:((

Előzmény: Miki2, 2011-07-17 16:26:00 [6104]

Ami lemaradt: Korántsem volt ilyen tetszetős. Csak működött.

Előzmény: Miki2, 2011-07-17 19:14:00 [6107]

A ྂ-es évek második felében építettem ilyen csövekkel, diszkrét elemekből (7400,7490, stb)órát, meg frekimérőt.

Előzmény: Gyárfás Attila, 2011-07-17 18:38:00 [6106]

Csak érdekesség képpen írom. Ezeket a csöveket tényleg nehézkes beszerezni, de azért még találni itt-ott. Db-ja 500ft-tól 2-3000ft ig is mehet, tipustól függ. Gyárilag ezek piros-vörös lakkal vannak bevonva, de melegvízzel lemoshtó, így szebb is. A neten rengeteg verzióban megtalálható, és van ahol árulják is, de nem egy olcsó db. Van ahol 3-400dollárt is elkérnek érte. Itthon 8-18ezer ft-ból megépíthető, de ez is tipustól függ, mivel van 1 csöves nixie óra is.

Előzmény: Miki2, 2011-07-17 16:26:00 [6104]

Igazad van Danibá!
Elnézést, átmegyek oda, ha ezzel kapcsolatba még bajom van.

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

Ilyem Nixi csövekkel sem találkozik már az ember naponta.
A kivitel nagyon tetszetős.
Sokkal látványosabb, mint egy vörös plexi mögé bújtatva.
Gratulálok az ötlethez, és a kivitelezéshez.

Előzmény: PSoft, 2011-07-17 00:00:00 [6099]

Sajnos ezzel sem működik.
A fogaskerék tökéletesen megy, de a cikloid...

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

Főleg ha összerakom.

Nagyon tetszik!

Előzmény: PSoft, 2011-07-17 00:00:00 [6099]

Nagyon klassz!

Előzmény: PSoft, 2011-07-17 00:00:00 [6099]

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]