Request: CreateGearwheel()
- Psychophanta
- Addict
- Posts: 4997
- Joined: Wed Jun 11, 2003 9:33 pm
- Location: Lípetsk, Russian Federation
- Contact:
Request: CreateGearwheel()
For example, similar to CreateTube() but with inner and/or outer teeths:
CreateGearwheel(#Mesh, OuterRadius.f, InnerRadius.f, Height.f [, OuterNbBaseSegments, InnerNbBaseSegments, NbHeightSegments, CloseTop]))
CreateGearwheel(#Mesh, OuterRadius.f, InnerRadius.f, Height.f [, OuterNbBaseSegments, InnerNbBaseSegments, NbHeightSegments, CloseTop]))
http://www.zeitgeistmovie.com
While world=business:world+mafia:Wend
Will never leave this forum until the absolute bugfree PB
While world=business:world+mafia:Wend
Will never leave this forum until the absolute bugfree PB
- pf shadoko
- Enthusiast
- Posts: 296
- Joined: Thu Jul 09, 2015 9:07 am
Re: Request: CreateGearwheel()
Code: Select all
Procedure CreateGearwheel(mesh.i,radius_min.f,radius_max.f,height,number)
Protected.i n,i,v
Protected.f a,r,x,y,z,h
n=CreateMesh(mesh):If mesh=-1:mesh=n:EndIf
h=height/2
MeshVertex(0,-h,0,0,0,0,0,-1,0) ; center bottom
MeshVertex(0, h,0,0,0,0,0,1,0) ; center top
For i=0 To number
a=2*#PI*i/number
If i & 1 :r=radius_min:Else:r=radius_max:EndIf
x=Cos(a)*r
z=Sin(a)*r
MeshVertex(x,-h,z,0,0,0,0,-1,0)
MeshVertex(x, h,z,0,0,0,0,1,0)
If i
v=2*i -2 + 2 ; !!!
MeshFace (0,v,v+2) ; bottom
MeshFace(v,v+1,v+2) ; side
MeshFace(v+1,v+3,v+2)
MeshFace (v+1,1,v+3) ; top
EndIf
Next
FinishMesh(1)
ProcedureReturn mesh
EndProcedure
InitEngine3D():InitSprite():InitKeyboard():InitMouse()
OpenWindow(0, 0, 0, 0,0, "4 X 4",#PB_Window_Maximize)
ex=WindowWidth (0,#PB_Window_InnerCoordinate)
ey=WindowHeight(0,#PB_Window_InnerCoordinate)
OpenWindowedScreen(WindowID(0), 0, 0, ex, ey, 0, 0, 0)
CreateCamera(0, 0, 0, 100, 100):MoveCamera(0,0,10,-20)
CreateLight(0,$888888, 10000, 5000, 2000)
CameraBackColor(0,$ff8888)
AmbientColor($444444)
CreateGearwheel(0,5,6,2,40)
CreateEntity(0,MeshID(0),#PB_Material_None)
Repeat
ExamineKeyboard()
WindowEvent()
RotateEntity(0,0.2,0.3,0.5,#PB_Relative)
CameraLookAt(0,EntityX(0),EntityY(0),EntityZ(0))
RenderWorld()
FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape)
- Psychophanta
- Addict
- Posts: 4997
- Joined: Wed Jun 11, 2003 9:33 pm
- Location: Lípetsk, Russian Federation
- Contact:
Re: Request: CreateGearwheel()
Many thanks pf shadoko, for your function.
http://www.zeitgeistmovie.com
While world=business:world+mafia:Wend
Will never leave this forum until the absolute bugfree PB
While world=business:world+mafia:Wend
Will never leave this forum until the absolute bugfree PB
- pf shadoko
- Enthusiast
- Posts: 296
- Joined: Thu Jul 09, 2015 9:07 am
Re: Request: CreateGearwheel()
a slightly better version,
with raised edges
with raised edges
Code: Select all
Procedure CreateGearwheel(mesh.i,radius_min.f,radius_max.f,height,number)
Protected.i n,i,v
Protected.f a,r,x,y,z,h
n=CreateMesh(mesh):If mesh=-1:mesh=n:EndIf
h=height/2
MeshVertex(0,-h,0,0,0,0,0,-1,0) ; center bottom
MeshVertex(0, h,0,0,0,0,0,1,0) ; center top
For i=0 To number
a=2*#PI*i/number
If i & 1 :r=radius_min:Else:r=radius_max:EndIf
x=Cos(a)*r
z=Sin(a)*r
MeshVertex(x,-h,z,0,0,0)
MeshVertex(x,-h,z,0,0,0)
MeshVertex(x,-h,z,0,0,0)
MeshVertex(x, h,z,0,0,0)
MeshVertex(x, h,z,0,0,0)
MeshVertex(x, h,z,0,0,0)
If i
v=6*i -6 + 2 ; !!!
MeshFace (0,v,v+6) ; bottom
MeshFace(v+1,v+4,v+8) ; side
MeshFace(v+4,v+9,v+8) ; side
MeshFace (1,v+11,v+5) ; top
EndIf
Next
FinishMesh(1)
NormalizeMesh(mesh)
ProcedureReturn mesh
EndProcedure
InitEngine3D():InitSprite():InitKeyboard():InitMouse()
OpenWindow(0, 0, 0, 0,0, "4 X 4",#PB_Window_Maximize)
ex=WindowWidth (0,#PB_Window_InnerCoordinate)
ey=WindowHeight(0,#PB_Window_InnerCoordinate)
OpenWindowedScreen(WindowID(0), 0, 0, ex, ey, 0, 0, 0)
CreateCamera(0, 0, 0, 100, 100):MoveCamera(0,0,10,-20)
CreateLight(0,$888888, 10000, 5000, 2000)
CameraBackColor(0,$ff8888)
AmbientColor($444444)
CreateGearwheel(0,5,6,2,40)
CreateEntity(0,MeshID(0),#PB_Material_None)
Repeat
ExamineKeyboard()
WindowEvent()
RotateEntity(0,0.2,0.3,0.5,#PB_Relative)
CameraLookAt(0,EntityX(0),EntityY(0),EntityZ(0))
RenderWorld()
FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape)
- Psychophanta
- Addict
- Posts: 4997
- Joined: Wed Jun 11, 2003 9:33 pm
- Location: Lípetsk, Russian Federation
- Contact:
Re: Request: CreateGearwheel()
Replacing lines 11, 12 and 13 to these ones, the result is still better.
Code: Select all
For i=0 To number*2
a=#PI*i/number
If i & 2 :r=radius_min:Else:r=radius_max:EndIf
http://www.zeitgeistmovie.com
While world=business:world+mafia:Wend
Will never leave this forum until the absolute bugfree PB
While world=business:world+mafia:Wend
Will never leave this forum until the absolute bugfree PB
- pf shadoko
- Enthusiast
- Posts: 296
- Joined: Thu Jul 09, 2015 9:07 am
Re: Request: CreateGearwheel()
very good idea !
Re: Request: CreateGearwheel()
Nice Gears, the two versions is nice, much better than using ready to use models.
just a note about the collisions with gears teeth
the Genuine gear (ie made with CreateGearwheel()) can pass forces to another genuine gear through using a compound entity (#PB_Entity_CompoundBody), but not directly since we don't have #PB_Entity_ConcaveBody.
here is an example : the white gear is a genuine gear, the red gear is a compound gear, the green gear is a genuine gear
just a note about the collisions with gears teeth
the Genuine gear (ie made with CreateGearwheel()) can pass forces to another genuine gear through using a compound entity (#PB_Entity_CompoundBody), but not directly since we don't have #PB_Entity_ConcaveBody.
here is an example : the white gear is a genuine gear, the red gear is a compound gear, the green gear is a genuine gear
Code: Select all
Procedure CreateGearwheel(mesh.i,radius_min.f,radius_max.f,height,number)
Protected.i n,i,v
Protected.f a,r,x,y,z,h
n=CreateMesh(mesh):If mesh=-1:mesh=n:EndIf
h=height/2
MeshVertex(0,-h,0,0,0,0,0,-1,0) ; center bottom
MeshVertex(0, h,0,0,0,0,0,1,0) ; center top
;For i=0 To number
; a=2*#PI*i/number
; If i & 1 :r=radius_min:Else:r=radius_max:EndIf
For i=0 To number*2
a=#PI*i/number
If i & 2 :r=radius_min:Else:r=radius_max:EndIf
x=Cos(a)*r
z=Sin(a)*r
MeshVertex(x,-h,z,0,0,0)
MeshVertex(x,-h,z,0,0,0)
MeshVertex(x,-h,z,0,0,0)
MeshVertex(x, h,z,0,0,0)
MeshVertex(x, h,z,0,0,0)
MeshVertex(x, h,z,0,0,0)
If i
v=6*i -6 + 2 ; !!!
MeshFace (0,v,v+6) ; bottom
MeshFace(v+1,v+4,v+8) ; side
MeshFace(v+4,v+9,v+8) ; side
MeshFace (1,v+11,v+5) ; top
EndIf
Next
FinishMesh(1)
NormalizeMesh(mesh)
ProcedureReturn mesh
EndProcedure
Define.f keyX, keyY, MouseX, MouseY, CameraSpeed
CameraSpeed = 0.3
InitEngine3D():InitSprite():InitKeyboard():InitMouse()
OpenWindow(0, 0, 0, 0,0, "Gears ,.... Z / X to rotate the White Gear ",#PB_Window_Maximize)
ex=WindowWidth (0,#PB_Window_InnerCoordinate)
ey=WindowHeight(0,#PB_Window_InnerCoordinate)
OpenWindowedScreen(WindowID(0), 0, 0, ex, ey, 0, 0, 0)
Add3DArchive("." , #PB_3DArchive_FileSystem)
Add3DArchive(#PB_Compiler_Home + "examples/3d/Data/" , #PB_3DArchive_FileSystem)
Add3DArchive(#PB_Compiler_Home + "examples/3d/Data/Textures" , #PB_3DArchive_FileSystem)
Add3DArchive(#PB_Compiler_Home + "examples/3d/Data/Models" , #PB_3DArchive_FileSystem)
Add3DArchive(#PB_Compiler_Home + "examples/3d/Data/Scripts" , #PB_3DArchive_FileSystem)
Parse3DScripts()
;WorldDebug(#PB_World_DebugBody)
;-------------------------------
; create material
CreateMaterial(1, LoadTexture(1, "wood.jpg"))
SetMaterialColor(1, #PB_Material_AmbientColor, #PB_Material_AmbientColors)
;
GetScriptMaterial(2, "Color/Green")
SetMaterialColor(2, #PB_Material_AmbientColor, #PB_Material_AmbientColors)
CreateMaterial(3, LoadTexture(3, "clouds.jpg"))
SetMaterialColor(3, #PB_Material_AmbientColor, #PB_Material_AmbientColors)
CreateMaterial(4, LoadTexture(4, "ground_diffuse.png"))
GetScriptMaterial(5, "Color/Red")
CreateMaterial(6, LoadTexture(6, "snow_1024.jpg"))
CreateMaterial(7, LoadTexture(7, "soil_wall.jpg"))
;-------------------------------
;LoadMesh(6, "gear_lwo.mesh")
CreateGearwheel(6 ,1.5,2,0.5,30)
Global Gear2 = CreateEntity(#PB_Any,0,0)
CreateEntity(6, MeshID(6),MaterialID(6), 0, 0, 0)
RotateEntity(6,90,0,0)
CreateCylinder(7, 0.5, 3 ) ; the blue axes
CreateEntity(7, MeshID(7),MaterialID(3), 0, 0, 0) ; add axes (does not have a real job)
RotateEntity(7,90,0,0)
;the component of red smaller gear which will attached later to the big white gear
CreateCylinder(8, 0.7, 1 , 3, 1, 1) ; triangular cylinder
For i=8 To 10 ; create tria cylinders entities from 8 to 10
CreateEntity(i, MeshID(8),MaterialID(5), 0, 0, 2)
RotateEntity(i, 90,90+rot,0, #PB_Absolute)
rot+40 ; 360/9 = 40
AddSubEntity(Gear2, i, #PB_Entity_ConvexHullBody)
Next
AddSubEntity(Gear2, 6, #PB_Entity_StaticBody) ; the white gear passed as dynamic concave geometry
AddSubEntity(Gear2, 7, #PB_Entity_CylinderBody)
AddSubEntity(Gear2, 8, #PB_Entity_ConvexHullBody)
AddSubEntity(Gear2, 9, #PB_Entity_ConvexHullBody)
AddSubEntity(Gear2, 10, #PB_Entity_ConvexHullBody)
CreateEntityBody(Gear2, #PB_Entity_CompoundBody, 5, 0.4, 1)
SetEntityAttribute(Gear2, #PB_Entity_DisableContactResponse, 1); disable collision
CreateEntity(11, MeshID(6),MaterialID(2), 0, 0, 0) ;another entity from the gear: "gear_lwo.mesh"
ScaleEntity(11, 0.5,0.5,0.5)
RotateEntity(11,90,0,0)
Global Gear3 = CreateEntity(#PB_Any,0,0) ; the green gear
AddSubEntity(Gear3, 11, #PB_Entity_StaticBody)
CreateEntityBody(Gear3, #PB_Entity_CompoundBody, 5, 0.4, 1)
SetEntityAttribute(Gear3, #PB_Entity_DisableContactResponse, 1); disable collision
;Ground
Ground = CreateCube(#PB_Any, 1)
Ground = CreateEntity(#PB_Any, MeshID(Ground), MaterialID(4), 0, -7, 0)
ScaleEntity(Ground, 40, 0.4, 40)
CreateEntityBody(Ground, #PB_Entity_StaticBody)
GenericJoint(5,EntityID(Ground), 3.1, 4, 0,EntityID(Gear2), 0, 0, 0)
SetJointAttribute(5, #PB_Joint_NoLimit, 0, 5)
GenericJoint(6,EntityID(Ground), 4.7, 4, 2,EntityID(Gear3), 0, 0, 0)
SetJointAttribute(6, #PB_Joint_NoLimit, 0, 5)
; camera
CreateCamera(0, 0, 0, 100, 100, #True)
MoveCamera(0,0,-2,10, #PB_Absolute)
CameraLookAt(0,1.5,-2,0)
CreateLight(1, RGB(255,255,255), 0, 5, 10)
Repeat
ExamineKeyboard()
WindowEvent()
If ExamineMouse()
MouseX = -MouseDeltaX() * CameraSpeed * 0.2
MouseY = -MouseDeltaY() * CameraSpeed * 0.2
EndIf
If ExamineKeyboard()
If KeyboardPushed(#PB_Key_Z)
ApplyEntityTorque(Gear2, 0, 0, 25)
ElseIf KeyboardPushed(#PB_Key_X)
ApplyEntityTorque(Gear2, 0, 0, -25)
ElseIf KeyboardPushed(#PB_Key_Space) ; in case gears teeth stuck
ApplyEntityImpulse(Gear2, -0.2, 0, 0, 0, 10,0)
EndIf
If KeyboardPushed(#PB_Key_Left)
KeyX = -CameraSpeed
ElseIf KeyboardPushed(#PB_Key_Right)
KeyX = CameraSpeed
Else
KeyX = 0
EndIf
If KeyboardPushed(#PB_Key_Up)
KeyY = -CameraSpeed
ElseIf KeyboardPushed(#PB_Key_Down)
KeyY = CameraSpeed
Else
KeyY = 0
EndIf
EndIf
MoveCamera (0, KeyX, 0, KeyY)
RotateCamera(0, MouseY, MouseX, 0, #PB_Relative)
RenderWorld()
FlipBuffers()
If twoseconds = 0
tm2.f = ElapsedMilliseconds()
If (tm2-tm) >= 1000 ; after 1 second enable the collison
;enable the collision for all the entities
SetEntityAttribute(Gear2, #PB_Entity_DisableContactResponse, 0)
SetEntityAttribute(Gear3, #PB_Entity_DisableContactResponse, 0)
twoseconds =1
EndIf
EndIf
Until KeyboardPushed(#PB_Key_Escape)
- pf shadoko
- Enthusiast
- Posts: 296
- Joined: Thu Jul 09, 2015 9:07 am
Re: Request: CreateGearwheel()
fine example
(not easy to do concave body !)
(not easy to do concave body !)
- Psychophanta
- Addict
- Posts: 4997
- Joined: Wed Jun 11, 2003 9:33 pm
- Location: Lípetsk, Russian Federation
- Contact:
Re: Request: CreateGearwheel()
Nice one applePi.
Looks like the a modern symbol of PureBasic:
styles/prosilver/imageset/pblogobb.png
Looks like the a modern symbol of PureBasic:
styles/prosilver/imageset/pblogobb.png
http://www.zeitgeistmovie.com
While world=business:world+mafia:Wend
Will never leave this forum until the absolute bugfree PB
While world=business:world+mafia:Wend
Will never leave this forum until the absolute bugfree PB