Posted: 11th Oct 2013 18:26
I found this little gem from Zotoaster's 2006 post.
See the original here: http://forum.thegamecreators.com/?m=forum_view&t=90402&b=1

All I've added is random x/y/z scaling, as well as texturing and a save feature. (Sorry for the sloppy in-loop coding.)

+ Code Snippet
autocam off:move camera -50:randomize timer():sync on:sync rate 25:wf=-1
ReStart:
if object exist(1) then delete object 1
color backdrop rgb(rnd(40),40+rnd(60),100+rnd(100))
make object sphere 1,100,rnd(20)+5,rnd(20)+5

lock vertexdata for limb 1,0
vc=get vertexdata vertex count()
for v=0 to vc-1
x#=get vertexdata position x(v)
y#=get vertexdata position y(v)
z#=get vertexdata position z(v)
set vertexdata position v,x#+rnd(5),y#+rnd(5),z#+rnd(5)
next v
unlock vertexdata

xx=rnd(100)+1
yy=rnd(100)+1
zz=rnd(100)+1
scale object 1,xx,yy,zz


make mesh from object 1,1:delete object 1
load image "YOUR TEXTURE PATH",1,1
make object 1,1,1:set object cull 1,0:set object wireframe 1,wf
scale object texture 1,(xx+zz/2)/15,yy/15

`OPTIONAL BLEND MAPPING [will not save into .DBO file!]
load image "YOUR BLEND MAP PATH",2,1
set blend mapping on 1,2,6

do
if spacekey()=1
while spacekey()=1
ENDWHILE
goto ReStart
ENDIF
if lower$(inkey$())="s"
ReRoll:
fn$="Rock_"+str$(rnd(10000))+".dbo"
if file exist(fn$) then goto ReRoll
save object fn$,1
print fn$;" saved!":sync:wait 2000
while lower$(inkey$())="s"
ENDWHILE
ENDIF
if upkey()=1 then move camera 1
if downkey()=1 then move camera -1
if leftkey()=1 then yrotate object 1,object angle y(1)+2
if rightkey()=1 then yrotate object 1,object angle y(1)-2
set cursor 0,0:print "SPACEBAR FOR NEW ROCK":print "ARROW KEYS TO ZOOM/ROTATE":print "'W' TO TOGGLE WIREFRAME":print "'S' TO SAVE THIS ROCK"
set cursor 490,0:print "Vertex Count: ",vc
if lower$(inkey$())="w" then wf=wf*-1:set object wireframe 1,wf
while inkey$()<>""
ENDWHILE
sync
LOOP


I'll be using this a lot for landscaping.
Thanks for sharing this, Zotoaster!
Posted: 12th Oct 2013 20:21
@Derek Darkly

Nice and quick way to make our rocks. When I see this code,that remember me to my old rock program. Instead of scaling object, what I did, is play vertexdata with a heightmap for modeling the mesh.I hope you do not mind, and you like my example.


You can add a save object function ...

+ Code Snippet
autocam off
sync on
position camera 0,230,-1000
pinta:
make object sphere 30000,200,49,49
rem reseting all ...
for i= 1 to 1000
   if object exist(i) then delete object i
next i

rem random terrain heightmap
create bitmap 1,50,50
  for i= 1 to 1300
      c=rnd(255)
      ink rgb(c,c,c),0
      a=rnd(60)
      b=rnd(60)
      box a,b,a+rnd(10),b+rnd(10)
  next i
  blur bitmap 1,6
 rem blur bitmap 1,3
  get image 1,0,0,50,50,1
delete bitmap 1

dim altura(50,50)
load image "floor10.jpg",2
paste image 1,0,0

rem saving in array the heightmap
lock pixels
   for x=0 to 50
      for y=0 to 50
         altura(y,x)=rgbr(point(50-x,y))/-1
      next y
   next x
unlock pixels

texture object 30000,2
scale object texture 30000,10,10
set object radius 30000,-1

rem adding helpers that push or pull every vertex
lock vertexdata for limb 30000,0
    vertices = get vertexdata vertex count()
    for i = 1 to vertices
        x# = get vertexdata position x(i)
        y# = get vertexdata position y(i)
        z# = get vertexdata position z(i)
       make object box i,1,1,2
       position object i,x#,y#,z#
       point object i,0,0,0
    next i
unlock vertexdata

rem moving every helper the color value of array
for i= 1 to 50
   for a= 1 to 50
       inc o
     if object exist(o) then  move object o,altura(i,a)
   next a
next i


rem  sewing initial vertex with the ends
for i= 99 to vertices step 50
    position object i,object position x(i-49),object position y(i-49),object position z(i-49)
next i

rem finally...modeling our rock
   lock vertexdata for limb 30000,0
   vertices = get vertexdata vertex count()
    for i = 1 to vertices
        x# = get vertexdata position x(i)
        y# = get vertexdata position y(i)
        z# = get vertexdata position z(i)
        xx#=object position x(i)
        yy#=object position y(i)
        zz#=object position z(i)
        bump=rnd(5)
        if i>100 and i< vertices -100 then set vertexdata position i,xx#+bump,yy#+bump,zz#+bump
        set vertexdata position 0,0,0,0        rem hide vertex 0
        delete object i
    next i
unlock vertexdata
set object normals 30000



do
paste image 1,0,50
ink rgb(255,255,255),0
set cursor 0,0
print "Press spacebar to change rock"

control camera using arrowkeys 0,1,1
a#=wrapvalue(a#+mousemovex()/2)
cam#=wrapvalue(cam#+mousemovey()/2)
rotate camera cam#,a#,0
if leftkey() then move camera left 1
if rightkey() then move camera right 1

if spacekey() then delete object 30000:o=0:goto pinta:sleep 100


sync
loop








Cheers.
Posted: 13th Oct 2013 8:48
Excellent Chafari!

Limiting the heightmap range also gives us good control over the smoothness of the rocks.... something like c=100+rnd(155) or equivalent.

This is definitely going into my app library!
Thanks a bunch!
Posted: 13th Oct 2013 21:24
Limiting the heightmap range also gives us good control over the smoothness of the rocks.... something like c=100+rnd(155) or equivalent.


You're right...it give us a smooth rock...we can combine . I'm glad you like it

Cheers.