ヒルベルト曲線

 投稿者：しばっち  投稿日：2011年 8月14日(日)23時36分27秒
  PUBLIC NUMERIC XS,YS,ZS,XE,YE,ZE
INPUT  PROMPT "LEVEL=": N
DIM A(3),B(3),C(3),D(3),E(3),F(3),G(3),H(3)
MAT READ A,B,C,D,E,F,G,H
DATA -1,1,1
DATA -1,1,-1
DATA -1,-1,-1
DATA -1,-1,1
DATA 1,-1,1
DATA 1,-1,-1
DATA 1,1,-1
DATA 1,1,1
LET RR=10
LET XS=0
LET YS=0
LET ZS=0
FILE GETSAVENAME F$, "dxfファイル|*.dxf"
IF RIGHT$(F$,1)="!" THEN LET F$=F$(1:LEN(F$)-1) & "ヒルベルト曲線" & STR$(N)
IF POS(UCASE$(F$),".DXF")=0 THEN LET F$=F$ & ".dxf"
OPEN #1:NAME F$
ERASE #1
PRINT #1:"0"
PRINT #1:"SECTION"
PRINT #1:"2"
PRINT #1:"ENTITIES"
CALL SPHERE(#1,XS,YS,ZS,RR)
CALL HILBERT(N,A,B,C,D,E,F,G,H,#1)
PRINT #1:"0"
PRINT #1:"ENDSEC"
PRINT #1:"0"
PRINT #1:"EOF"
CLOSE #1
END

EXTERNAL  SUB HILBERT(N,A(),B(),C(),D(),E(),F(),G(),H(),#1)
IF N>0 THEN
   CALL HILBERT(N-1,A,D,E,H,G,F,C,B,#1)
   CALL MOVE(A,B,#1)
   CALL HILBERT(N-1,A,H,G,B,C,F,E,D,#1)
   CALL MOVE(B,C,#1)
   CALL HILBERT(N-1,A,H,G,B,C,F,E,D,#1)
   CALL MOVE(C,D,#1)
   CALL HILBERT(N-1,C,D,A,B,G,H,E,F,#1)
   CALL MOVE(D,E,#1)
   CALL HILBERT(N-1,C,D,A,B,G,H,E,F,#1)
   CALL MOVE(E,F,#1)
   CALL HILBERT(N-1,E,D,C,F,G,B,A,H,#1)
   CALL MOVE(F,G,#1)
   CALL HILBERT(N-1,E,D,C,F,G,B,A,H,#1)
   CALL MOVE(G,H,#1)
   CALL HILBERT(N-1,G,F,C,B,A,D,E,H,#1)
END IF
END SUB

EXTERNAL  SUB MOVE(A(),B(),#1)
LET  L=100 !'移動量
LET  RR=10 !'チューブ半径
LET  XE=XS+L*(B(1)-A(1))/2
LET  YE=YS+L*(B(2)-A(2))/2
LET  ZE=ZS+L*(B(3)-A(3))/2
CALL TUBE(#1,XS,YS,ZS,XE,YE,ZE,RR)
CALL SPHERE(#1,XE,YE,ZE,RR) !'関節部に球を配置
LET XS=XE
LET YS=YE
LET ZS=ZE
END SUB

以下省略
EXTERNAL  SUB TUBE(#1,X0,Y0,Z0,X1,Y1,Z1,LL) !'チューブ(蓋なし)
END SUB

EXTERNAL  SUB SPHERE(#1,XX,YY,ZZ,RR) !'球
END SUB

EXTERNAL  SUB ROTATE(XX,YY,ZZ,X0,Y0,Z0,TH,NX,NY,NZ) !'任意軸回転(ロドリグの公式)
END SUB

ヒルベルト曲線 レベル4(ファイルサイズ 約76MB)
 

戻る