马赛克【附代码】

夜神

060817MosiacCat01[1].jpg (57.06 KB, 下载次数: 8)

2010-6-22 16:11 上传

点击文件名下载附件
阅读权限: 10
代码未经过完全测试，可能个别情况下会出错。
发现bug请指出，谢谢。
'========================================

Option Explicit
run
SUB run
makeMosiac Rhino.GetObject("请选择物体", 0),Rhino.IntegerBox("最短方向的方块数",6),Rhino.RealBox("方块缩小比例",0.9)
END SUB
'--------------------------------------------
' nDensity：最小boundingBox边长的分段数
' rShrink：方块缩小比例
'--------------------------------------------
FUNCTION makeMosiac(obj,nDensity,rShrink)
DIM objs : objs=array(obj)
DIM pBox, boundingBox : pBox=Rhino.BoundingBox(objs)
DIM nX,nY,nZ  '包围盒三边的分段数
DIM minSide  '最短边代码
DIM lSide(2)  '包围盒三边长
DIM objTemp
DIM lCube   '马赛克边长
DIM iX,iY,iZ  '三个边的截线数
'计算最短边、马赛克边长、三个方向的马赛克数
lSide(0)=pBox(1)(0)-pBox(0)(0)
lSide(1)=pBox(2)(1)-pBox(1)(1)
lSide(2)=pBox(4)(2)-pBox(0)(2)
IF lSide(0)<=lSide(1) AND lSide(0)<=lSide(2) THEN
  minSide=0
  lCube=lSide(minSide)/nDensity
  iX=nDensity
  iY=int(lSide(1)/lCube+0.5) '四舍五入
  iZ=int(lSide(2)/lCube+0.5)
END IF
IF lSide(1)<=lSide(0) AND lSide(1)<=lSide(2) THEN
  minSide=1
  lCube=lSide(minSide)/nDensity
  iX=int(lSide(0)/lCube+0.5)
  iY=nDensity
  iZ=int(lSide(2)/lCube+0.5)
END IF
IF lSide(2)<=lSide(0) AND lSide(2)<=lSide(1) THEN
  minSide=2
  lCube=lSide(minSide)/nDensity
  iX=int(lSide(0)/lCube+0.5)
  iY=int(lSide(1)/lCube+0.5)
  iZ=nDensity
END IF
'定义马赛克空间， 并初始化为零（该空间没有马赛克）
DIM i,j,k,m,s
DIM p() : REDIM p((iX+1)*(iY+1)*(iZ+1))
FOR i=0 TO iX
  FOR j=0 TO iY
   FOR k=0 TO iZ
    p(i*(iY+1)*(iZ+1)+j*(iZ+1)+k)=0
   NEXT
  NEXT
NEXT
DIM iRoundUp '圆整后的坐标序号
DIM pCube(7)
'拆分物体
DIM nObjs : nObjs=UBound(objs)  '选择要马赛克的物体的数目
DIM nSfs  : nSfs=0 '打散后的NURBS曲面总数
DIM sfs()  : REDIM sfs(nSfs) '打散后的NURBS曲面
DIM sfsInEach,sfsInEachPlane,pVertice,pMeshFaces
DIM arrVerticeNum,nMeshFace '顶点序号;Mesh内面片数 '
FOR i=0 TO nObjs '对每一个所选的物体
  IF Rhino.IsSurface(objs(i))=vbTRUE AND Rhino.IsSurfaceTrimmed(objs(i))=vbFALSE THEN  '是单曲面，且不是裁剪曲面
   sfs(UBound(sfs))=objs(i)
   REDIM PRESERVE sfs(UBound(sfs)+1)
  ELSE  '是复合曲面或裁剪曲面
   Rhino.SelectObject objs(i)   
   Rhino.Command "-Mesh PolygonDensity 12  Enter Enter "  '数字12表示离散后的mesh精度，越大越精细，计算量也越大
   objTemp=Rhino.FirstObject(vbTRUE)   'Mesh面
   pMeshFaces=Rhino.MeshFaces(objTemp, vbTRUE)  'Mesh内所有顶点的集合
   arrVerticeNum=Rhino.MeshFaceVertices(objTemp)  'Mesh内各面角点序号集合
   nMeshFace=UBound(arrVerticeNum)  '面片总数
   Rhino.DeleteObject objTemp  '删除Mesh
   FOR j=0 TO nMeshFace '为每一个Mesh面片建立曲面
    objTemp=Rhino.AddSrfPt(Array(pMeshFaces(j*4+0),pMeshFaces(j*4+1),pMeshFaces(j*4+2),pMeshFaces(j*4+3)))
    sfs(UBound(sfs))=objTemp
    REDIM PRESERVE sfs(UBound(sfs)+1)
   NEXT
  END IF
NEXT
Rhino.UnSelectAllObjects
REDIM PRESERVE sfs(UBound(sfs)-1)
nSfs=UBound(sfs)
DIM pNorm,pStart,pEnd,sectLine,pSect,nSectPoints
'第一轮：平行Z轴
dim pTemp() :redim pTemp(0)
FOR i=0 TO iX
  FOR j=0 TO iY
   pStart=Array(pBox(0)(0)+i*lCube, pBox(0)(1)+j*lCube, pBox(0)(2))
   pEnd=Array(pBox(0)(0)+i*lCube, pBox(0)(1)+j*lCube, pBox(4)(2))
   sectLine=Rhino.AddLine(pStart,pEnd)
   FOR m=0 TO nSfs
    pSect=Rhino.CurveSurfaceIntersection(sectLine, sfs(m))
    IF IsArray(pSect)=vbTRUE THEN  '有交叉点，(此句费解，去掉IF后pSect就不是数组了)
     nSectPoints=UBound(pSect,1) '交叉点个数
     FOR k=0 TO nSectPoints
      iRoundUp=int((pSect(k,1)(2)-pStart(2))/lCube+0.5) '把交叉点位置圆整到马赛克中心
      p(i*(iY+1)*(iZ+1)+j*(iZ+1)+iRoundUp)=1 '该位置的马赛克状态为1（有马赛克）
      pTemp(ubound(pTemp))=Rhino.AddPoint(pSect(k,1))
      redim preserve pTemp(ubound(pTemp)+1)
     NEXT
    END IF
   NEXT
   Rhino.DeleteObject sectLine
  NEXT
NEXT
'第二轮：平行X轴
FOR k=0 TO iZ
  FOR j=0 TO iY
   pStart=Array(pBox(0)(0), pBox(0)(1)+j*lCube, pBox(0)(2)+k*lCube)
   pEnd=Array(pBox(2)(0), pBox(0)(1)+j*lCube, pBox(0)(2)+k*lCube)
   sectLine=Rhino.AddLine(pStart,pEnd)
   FOR m=0 TO nSfs
    pSect=Rhino.CurveSurfaceIntersection(sectLine, sfs(m))
    IF IsArray(pSect) THEN '有交叉点
     nSectPoints=UBound(pSect,1) '交叉点个数
     FOR i=0 TO nSectPoints
      iRoundUp=int((pSect(i,1)(0)-pStart(0))/lCube+0.5)
      p(iRoundUp*(iY+1)*(iZ+1)+j*(iZ+1)+k)=1
      pTemp(ubound(pTemp))=Rhino.AddPoint(pSect(i,1))
      redim preserve pTemp(ubound(pTemp)+1)
     NEXT
    END IF
   NEXT
   Rhino.DeleteObject sectLine
  NEXT
NEXT
'第三轮：平行Y轴
FOR k=0 TO iZ
  FOR i=0 TO iX
   pStart=Array(pBox(0)(0)+i*lCube, pBox(0)(1), pBox(0)(2)+k*lCube)
   pEnd=Array(pBox(0)(0)+i*lCube, pBox(3)(1), pBox(0)(2)+k*lCube)
   sectLine=Rhino.AddLine(pStart,pEnd)
   FOR m=0 TO nSfs
    pSect=Rhino.CurveSurfaceIntersection(sectLine, sfs(m))
    IF IsArray(pSect) THEN '有交叉点
     nSectPoints=UBound(pSect,1) '交叉点个数
     FOR j=0 TO nSectPoints
      iRoundUp=int((pSect(j,1)(1)-pStart(1))/lCube+0.5)
      p(i*(iY+1)*(iZ+1)+iRoundUp*(iZ+1)+k)=1
      pTemp(ubound(pTemp))=Rhino.AddPoint(pSect(j,1))
      redim preserve pTemp(ubound(pTemp)+1)
     NEXT
    END IF
   NEXT
   Rhino.DeleteObject sectLine
  NEXT
NEXT
redim preserve pTemp(ubound(pTemp)-1)
'根据记录的方块属性画方块
dim lCube2  '缩后的Cube边长
lCube2=rShrink*lCube
FOR i=0 TO iX
  FOR j=0 TO iY
   FOR k=0 TO iZ
    IF p(i*(iY+1)*(iZ+1)+j*(iZ+1)+k)=1  THEN
     pCube(0)=Array(pBox(0)(0)+i*lCube-lCube2/2,pBox(0)(1)+j*lCube-lCube2/2,pBox(0)(2)+k*lCube-lCube2/2)
     pCube(1)=Array(pBox(0)(0)+i*lCube+lCube2/2,pBox(0)(1)+j*lCube-lCube2/2,pBox(0)(2)+k*lCube-lCube2/2)
     pCube(2)=Array(pBox(0)(0)+i*lCube+lCube2/2,pBox(0)(1)+j*lCube+lCube2/2,pBox(0)(2)+k*lCube-lCube2/2)
     pCube(3)=Array(pBox(0)(0)+i*lCube-lCube2/2,pBox(0)(1)+j*lCube+lCube2/2,pBox(0)(2)+k*lCube-lCube2/2)
     pCube(4)=Array(pBox(0)(0)+i*lCube-lCube2/2,pBox(0)(1)+j*lCube-lCube2/2,pBox(0)(2)+k*lCube+lCube2/2)
     pCube(5)=Array(pBox(0)(0)+i*lCube+lCube2/2,pBox(0)(1)+j*lCube-lCube2/2,pBox(0)(2)+k*lCube+lCube2/2)
     pCube(6)=Array(pBox(0)(0)+i*lCube+lCube2/2,pBox(0)(1)+j*lCube+lCube2/2,pBox(0)(2)+k*lCube+lCube2/2)
     pCube(7)=Array(pBox(0)(0)+i*lCube-lCube2/2,pBox(0)(1)+j*lCube+lCube2/2,pBox(0)(2)+k*lCube+lCube2/2)
     Rhino.AddBox pCube
    END IF
   NEXT
  NEXT
NEXT
Rhino.DeleteObjects sfs '删除原始物体
Rhino.DeleteObjects pTemp '删除点
makeMosiac=sfs
END FUNCTION

mgltju

论坛高手云集，厉害厉害

左手◆23年

感谢楼主分享，赞一个

阿兹海默青年

到现在都还没这么牛逼

liuliu8244

学习一下，lz继续加油

多吃水果蔬菜

做的真好！羡慕你！

鹰眼黑客

楼主的分享精神值得赞扬。

bizquit

楼主强大啊

蚊子

什么都看不见啊

jasonbb88

厉害~~~~~~~

s.k.

我要学编程啊

howldyx

收藏之哈哈哈

howldyx

感谢楼主分享啊。。。。。。。。

hying

顶。。。！

M-chibitora

牛人啊！！！学习了哈哈

anboyh

谢谢楼主分享。

mqcjackson

我觉得做得挺好的……小白~~

kewangzhenxiang

我没照度了，，，送电给我吧。。。

wawa

very good!!!!!!!!

renping88

w                        ew

renping88

ds                  w