VTKファイルをつくる9

 投稿者:しばっち  投稿日:2018年 3月10日(土)21時03分59秒
  これも各点の座標を求め、点と点を線でつないでいます
前述と同じように操作してください。
このプログラムではスカラー値は設定していません。

OPTION ANGLE DEGREES
PUBLIC NUMERIC XX(2730),YY(2730),ZZ(2730),K !' 2+8*(4^(LEV-1)-1)/3
INPUT PROMPT "LEVEL(2<=LEV<=6)=":LEV
CALL TREE(LEV,0,0,0,0,2^LEV,0,2^LEV)
FILE GETSAVENAME F$,"vtkファイル|*.vtk"
IF F$="" THEN STOP
IF POS(UCASE$(F$),".VTK")=0 THEN LET F$=F$&".vtk"
OPEN #1:NAME F$
ERASE #1
PRINT #1:"# vtk DataFile Version 4.0"
PRINT #1:"tree"
PRINT #1:"ASCII"
PRINT #1:"DATASET POLYDATA"
PRINT #1:"POINTS";K;"double"
FOR I=1 TO K
   PRINT #1:XX(I);YY(I);ZZ(I)
NEXT I
PRINT #1:"LINES";K/2;3*K/2
FOR I=0 TO K-1 STEP 2
   PRINT #1:2;I;I+1
NEXT I
CLOSE #1
END

EXTERNAL SUB TREE(N,XS,YS,ZS,XE,YE,ZE,L)
IF N>0 THEN
   LET K=K+1      !'個数
   LET XX(K)=XS   !'座標値を記録
   LET YY(K)=YS
   LET ZZ(K)=ZS
   LET K=K+1
   LET XX(K)=XE
   LET YY(K)=YE
   LET ZZ(K)=ZE
   LET X=XE-XS
   LET Y=YE-YS
   LET Z=ZE-ZS
   IF X<>0 THEN
      CALL TREE(N-1,XE,YE,ZE,XE,YE,ZE+L/2,L/2)
      CALL TREE(N-1,XE,YE,ZE,XE,YE,ZE-L/2,L/2)
      CALL TREE(N-1,XE,YE,ZE,XE,YE+L/2,ZE,L/2)
      CALL TREE(N-1,XE,YE,ZE,XE,YE-L/2,ZE,L/2)
   END IF
   IF Y<>0 THEN
      CALL TREE(N-1,XE,YE,ZE,XE+L/2,YE,ZE,L/2)
      CALL TREE(N-1,XE,YE,ZE,XE-L/2,YE,ZE,L/2)
      CALL TREE(N-1,XE,YE,ZE,XE,YE,ZE+L/2,L/2)
      CALL TREE(N-1,XE,YE,ZE,XE,YE,ZE-L/2,L/2)
   END IF
   IF Z<>0 THEN
      CALL TREE(N-1,XE,YE,ZE,XE+L/2,YE,ZE,L/2)
      CALL TREE(N-1,XE,YE,ZE,XE-L/2,YE,ZE,L/2)
      CALL TREE(N-1,XE,YE,ZE,XE,YE+L/2,ZE,L/2)
      CALL TREE(N-1,XE,YE,ZE,XE,YE-L/2,ZE,L/2)
   END IF
END IF
END SUB
 

戻る