|
|
このプログラムもボリュームレンダリング機能を使用します。
領域判定し、2値データを書き込んでいます。
前述と同じように操作してください。
マシンパワーによって各格子のサイズを調整してください。
LET XSIZE=100 !'各格子の大きさ
LET YSIZE=100
LET ZSIZE=100
INPUT PROMPT "MODE(1 - 28)=":MODE
SELECT CASE MODE
CASE 1
LET R=1
LET N=4
LET M=1.2
LET O=.7
CASE 2
LET R=2
LET A=1
LET B=1
LET C=1
LET D=-.5
LET E=.3
LET F=.7
LET G=-.05
LET H=.8
LET I=1
LET J=-1
CASE 3
LET R=1
LET A=1
LET B=.5
LET C=.8
CASE 4
LET R=4
LET A=1
LET B=.5
LET C=.8
CASE 5
LET R=4
LET A=1
LET B=.5
LET C=.8
CASE 6
LET R=4
LET A=1
LET B=.5
LET C=.8
CASE 7
LET R=2
LET A=1
LET B=.5
CASE 8
LET R=4
LET A=1
LET B=.5
CASE 9
LET R=3
LET A=1
LET B=1
CASE 10
LET R=4
LET A=1
LET B=.5
CASE 11
LET R=4
LET A=.3
CASE 12
LET R=2
LET A=1
LET B=.7
LET C=.4
LET D=1
LET R2=1
LET R1=3
LET R=5
CASE 13
LET R=2
LET A=1
LET B=2
LET C=1.5
LET N=.5
LET O=1.2
CASE 14
LET R=4
LET A=1
LET B=2
LET C=1.5
LET N=.5
LET O=1.2
CASE 15
LET R=4
LET A=1
LET B=2
LET C=1.5
LET N=.5
LET O=1.2
CASE 16
LET R=2
LET A=1
LET B=2
LET C=1.5
LET N=.5
LET O=1.2
CASE 17
LET R=2
LET A=1.8
CASE 18
LET R=2
CASE 19
LET R=3
LET C=1
LET B=1.5
CASE 20
LET R=3
CASE 21
LET R=4
CASE 22
LET R=20
CASE 23
LET R=20
CASE 24
LET R=100
CASE 25
LET R=5
CASE 26
LET R=6
CASE 27
LET R=2
LET N=2
LET E=3
CASE 28
LET R=5
END SELECT
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 2.0"
PRINT #1:"inequality"
PRINT #1:"ASCII"
PRINT #1:"DATASET STRUCTURED_POINTS"
PRINT #1:"DIMENSIONS";XSIZE;YSIZE;ZSIZE
PRINT #1:"ORIGIN 0 0 0"
PRINT #1:"SPACING 1 1 1"
PRINT #1:"POINT_DATA";XSIZE*YSIZE*ZSIZE
PRINT #1:"SCALARS scalar float"
PRINT #1:"LOOKUP_TABLE default"
FOR Z=0 TO ZSIZE-1
FOR Y=0 TO YSIZE-1
FOR X=0 TO XSIZE-1
IF FUNC(-R+X*2*R/XSIZE,-R+Y*2*R/YSIZE,-R+Z*2*R/ZSIZE)=1 THEN LET DA=255 ELSE LET DA=0
PRINT #1:DA
NEXT X
NEXT Y
NEXT Z
CLOSE #1
FUNCTION FUNC(X,Y,Z)
LET FL=0
SELECT CASE MODE
CASE 1
!'立方体
IF ABS(X)^N+ABS(Y)^M+ABS(Z)^O<1 THEN LET FL=1
CASE 2
!'一般形
IF A*X^2+B*Y^2+C*Z^2+D*X*Y+E*Y*Z+F*X*Z+G*X+H*Y+Z*I+J<0 THEN LET FL=1
CASE 3
!'楕円面
IF X^2/A^2+Y^2/B^2+Z^2/C^2<1 THEN LET FL=1
CASE 4
!'１葉双曲面
IF X^2/A^2+Y^2/B^2-Z^2/C^2<1 THEN LET FL=1
CASE 5
!'２葉双曲面
IF X^2/A^2+Y^2/B^2-Z^2/C^2<-1 THEN LET FL=1
CASE 6
!'楕円錐面
IF X^2/A^2+Y^2/B^2-Z^2/C^2<0 THEN LET FL=1
CASE 7
!'楕円放物面
IF X^2/A^2+Y^2/B^2<Z THEN LET FL=1
CASE 8
!'双曲放物面
IF X^2/A^2-Y^2/B^2<Z THEN LET FL=1
CASE 9
!'楕円柱面
IF(X/A)^2+(Z/B)^2<1 THEN LET FL=1
CASE 10
!'双曲柱面
IF X^2/A^2-Y^2/B^2<1 THEN LET FL=1
CASE 11
!'放物柱面
IF X-1/4/A*Y^2<0 THEN LET FL=1
CASE 12
!'トーラス面
IF X^2+Y^2+Z^2-2*R1*SQR(X^2+Y^2)+R1^2-R2^2<0 THEN LET FL=1
CASE 13
!'超楕円面
IF(ABS(X/A)^(2/N)+ABS(Y/B)^(2/O))^(N/O)+ABS(Z/C)^(2/O)<1 THEN LET FL=1
CASE 14
!'超１葉双曲面
IF(ABS(X/A)^(2/N)+ABS(Y/B)^(2/O))^(N/O)-ABS(Z/C)^(2/O)<1 THEN LET FL=1
CASE 15
!'超２葉双曲面
IF-(ABS(X/A)^(2/N)+ABS(Y/B)^(2/O))^(N/O)+ABS(Z/C)^(2/O)<1 THEN LET FL=1
CASE 16
!'超トーラス面
IF ABS((ABS(X/A)^(2/N)+ABS(Y/B)^(2/N))^(N/2)-D)^(2/O)+ABS(Z/C)^(2/O)<1 THEN LET FL=1
CASE 17
!'レムニスケート
IF(X^2+Y^2+Z^2)^2-A^2*(Z^2-X^2-Y^2)<0 THEN LET FL=1
CASE 18
!'ハート
IF(2*X^2+Y^2+Z^2-1)^3-(1/10)*X^2*Z^3-Y^2*Z^3<0 THEN LET FL=1
CASE 19
!'円錐
IF X^2+Z^2-C^2*(1-(Y/B))^2<1 THEN LET FL=1
CASE 20
IF X^2+Z^2<1 OR Y^2+Z^2<1 OR X^2+Y^2<1 THEN LET FL=1
CASE 21
IF Y^2+(Z+2)^2<1 OR X^2+(Z+2)^2<1 OR Z<6-4*SQR(X^2+Y^2) THEN LET FL=1
CASE 22
IF(4*X^2+Y^2+Z^2-14*SQR(4*X^2+Y^2)+48)*(X^2+4*Y^2+Z^2-14*SQR(Z^2+4*Y^2)+48)*(X^2+Y^2+4*Z^2-14*SQR(X^2+4*Z^2)+48)<0 THEN LET FL=1
CASE 23
IF(X^2+Y^2+Z^2-17*SQR(X^2+Y^2)+69.5)*((X+8.5)^2+Y^2+Z^2-10*SQR((X+8.5)^2+Y^2)+22.5)*((X-8.5)^2+Y^2+Z^2-10*SQR((X-8.5)^2+Y^2)+22.5)*((Y+8.5)^2+X^2+Z^2-10*SQR((Y+8.5)^2+X^2)+22.5)*((Y-8.5)^2+X^2+Z^2-10*SQR((Y-8.5)^2+X^2)+22.5)<0 THEN LET FL=1
CASE 24
IF((X/4)^2+Y^2+Z^2-1)*((Y/4)^2+X^2+Z^2-1)*((Z/4)^2+Y^2+X^2-1)*(X^2+Y^2+Z^2-10*SQR(X^2+Y^2)+24)<0 THEN LET FL=1
CASE 25
IF (TAN(3*X)^2+TAN(3*Y)^2-.1)<0 OR (TAN(3*Y)^2+TAN(3*Z)^2-.1)<0 OR (TAN(3*Z)^2+TAN(3*X)^2-.1)<0 THEN LET FL=1
CASE 26
IF(X^2+Y^2+Z^2-1)*(X^2+Y^2+16*Z^2-6*SQR(X^2+Y^2)+8)<0 THEN LET FL=1
CASE 27
IF(ABS(X)^(2/E)+ABS(Y)^(2/E))^(E/N)+ABS(Z)^(2/N)-1<0 THEN LET FL=1
CASE 28
IF SIN(X)+2*SIN(Y)+3*SIN(Z)+4*SIN(X)+5*SIN(Y)+6*SIN(Z)<0 THEN LET FL=1
END SELECT
LET FUNC=FL
END FUNCTION
END
|
|