PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

Request: CreateGearwheel()

https://www.purebasic.fr/english/viewtopic.php?t=74712

Page 1 of 1

Request: CreateGearwheel()

Posted: Thu Feb 27, 2020 3:26 pm
by Psychophanta
For example, similar to CreateTube() but with inner and/or outer teeths:
CreateGearwheel(#Mesh, OuterRadius.f, InnerRadius.f, Height.f [, OuterNbBaseSegments, InnerNbBaseSegments, NbHeightSegments, CloseTop]))

Re: Request: CreateGearwheel()

Posted: Thu Feb 27, 2020 10:37 pm
by pf shadoko

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)

Re: Request: CreateGearwheel()

Posted: Fri Feb 28, 2020 10:48 am
by Psychophanta
Many thanks pf shadoko, for your function.
:)

Re: Request: CreateGearwheel()

Posted: Mon Mar 02, 2020 11:10 pm
by pf shadoko
a slightly better version,
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)

Re: Request: CreateGearwheel()

Posted: Tue Mar 03, 2020 9:58 pm
by Psychophanta
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

Re: Request: CreateGearwheel()

Posted: Thu Mar 05, 2020 10:15 am
by pf shadoko
very good idea !

Re: Request: CreateGearwheel()

Posted: Thu Mar 05, 2020 3:18 pm
by applePi
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

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)

Re: Request: CreateGearwheel()

Posted: Thu Mar 05, 2020 5:57 pm
by pf shadoko
fine example
(not easy to do concave body !)

Re: Request: CreateGearwheel()

Posted: Fri Mar 06, 2020 9:36 am
by Psychophanta
Nice one applePi.
Looks like the a modern symbol of PureBasic:
styles/prosilver/imageset/pblogobb.png
:D
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited