十進BASIC第2掲示板過去ログ

自己相似写像で描く多面体

投稿者：SECOND 投稿日：2011年 6月18日(土)15時29分4秒

!自己相似写像で描く !正多面体(4,8,12,20)と、切頂20面体( 32面体・サッカーボール) !--------------------------------------------------------- !フラクタル画像で用いた自己相似写像を、立体まで拡張。 !多数の重複画を生じる能率の悪さは、課題に残るが、取り合えず描ける。 OPTION ARITHMETIC NATIVE SET WINDOW -1.4, 1.6, -0.75, 2.25 DIM rotx(4,4), rotx1(4,4) MAT rotx=IDN MAT rotx1=IDN ! CALL mat_rotx1(-PI/4) !見下ろし角 DO SET DRAW mode hidden CLEAR SELECT CASE IP(S) CASE 0 CALL mat_rotx(-PI/4.305) !３２面体 !4.304~4.306 DRAW D32(5) WITH SHIFT(-.5,-SQR(3)/6)*ROTATE(rx)*rotx1 LET s=s+0.04 CASE 1 CALL mat_rotx(-PI/4.305) !正２０面体 !4.303~4.305 DRAW D20(4) WITH SHIFT(-.5,-SQR(3)/6)*ROTATE(rx)*rotx1 LET s=s+0.04 CASE 2 CALL mat_rotx(-PI/2.8376) !正１２面体 !2.8375~2.8378 DRAW D12(2) WITH SHIFT(-.5,-SQR(3)/2)*ROTATE(rx)*rotx1*SCALE(.7) LET s=s+0.04 CASE 3 CALL mat_rotx(-PI/2.552) !正８面体 !2.550~2.552 DRAW D20(2) WITH SHIFT(-.5,-SQR(3)/6)*ROTATE(rx)*rotx1*SCALE(1.4) LET s=s+0.04 CASE 4 CALL mat_rotx(-PI/1.644) !正４面体 !1.641~1.646~7 DRAW D20(1) WITH SHIFT(-.5,-SQR(3)/6)*ROTATE(rx)*rotx1*SCALE(1.4) LET s=s+0.04 CASE ELSE LET s=0 END SELECT SET DRAW mode explicit LET rx=rx+PI/128 WAIT DELAY .05 mouse poll mx,my,mlb,mrb LOOP UNTIL mrb=1 PICTURE D32(k) IF 0< k THEN DRAW D32(k-1) WITH ROTATE(-PI/3)*rotx !下 DRAW D32(k-1) WITH ROTATE( PI )*rotx*ROTATE(-PI*2/3) !左上 DRAW D32(k-1) WITH ROTATE(-PI/3)*rotx*ROTATE( PI*2/3)*SHIFT(1,0) !右上 !DRAW D32(k-1) !中(不要) ELSE PLOT LINES :1/3,0; 2/3,0; 5/6,SQR(3)/6; 2/3,SQR(3)/3; 1/3,SQR(3)/3; 1/6,SQR(3)/6; 1/3,0 END IF END PICTURE PICTURE D20(k) IF 0< k THEN DRAW D20(k-1) WITH ROTATE(-PI/3)*rotx !下 DRAW D20(k-1) WITH ROTATE( PI )*rotx*ROTATE(-PI*2/3) !左上 DRAW D20(k-1) WITH ROTATE(-PI/3)*rotx*ROTATE( PI*2/3)*SHIFT(1,0) !右上 !DRAW D20(k-1) !中(不要) ELSE PLOT LINES :0,0; 1,0; 0.5,SQR(3)/2; 0,0 END IF END PICTURE PICTURE D12(k) IF 0< k THEN DRAW D12(k-1) WITH ROTATE(-PI*3/5)*rotx !下 DRAW D12(k-1) WITH ROTATE( PI )*rotx*ROTATE(-PI*2/5) !左下 DRAW D12(k-1) WITH ROTATE( PI )*rotx*ROTATE(-PI*4/5)*SHIFT(-COS(PI*2/5),SIN(PI*2/5)) !左上 DRAW D12(k-1) WITH ROTATE(-PI*3/5)*rotx*ROTATE( PI*2/5)*SHIFT(1,0) !右下 DRAW D12(k-1) WITH ROTATE(-PI*3/5)*rotx*ROTATE( PI*4/5)*SHIFT(1+COS(PI*2/5),SIN(PI*2/5)) !右上 !DRAW D12(k-1) !中(不要) ELSE PLOT LINES :0,0; 1,0; 1+COS(PI*2/5),SIN(PI*2/5); 0.5,SIN(PI*2/5)+SIN(PI/5);-COS(PI*2/5),SIN(PI*2/5); 0,0 END IF END PICTURE !--------------------------------- !ｘ軸を、軸として回転する行列 rotx !(x,y,z,1)| 1, 0, 0, 0 | ! | 0, cos(a), sin(a), 0 | ! | 0,-sin(a), cos(a), 0 | ! | 0, 0, 0, 1 | !--------------------------------- SUB mat_rotx(a) LET rotx(2,2)=COS(a) LET rotx(3,2)=-SIN(a) LET rotx(2,3)=SIN(a) LET rotx(3,3)=COS(a) END SUB SUB mat_rotx1(a) LET rotx1(2,2)=COS(a) LET rotx1(3,2)=-SIN(a) LET rotx1(2,3)=SIN(a) LET rotx1(3,3)=COS(a) END SUB END

Re: 自己相似写像で描く多面体

投稿者：SECOND 投稿日：2011年 7月 2日(土)06時15分37秒

> No.1590[元記事へ] !自己相似写像で描く !正多面体(4,8,12,20)と、切頂20面体( 32面体・フラーレン・サッカーボール) !--------------------------------------------------------- !立体カラー版。面と線の見え隠れを描く。 OPTION ARITHMETIC NATIVE SET WINDOW -1.4, 1.6, -0.75, 2.25 DIM rotx(4,4), rotx1(4,4), rotx2(4,4) DIM Vi(4), Vo(4), m(4,4), D3( 32+1, 0 TO 6, 3) DIM p3(0 TO 3, 2), p5(0 TO 5, 2), p6(0 TO 6, 2) ! MAT rotx=IDN MAT rotx1=IDN MAT rotx2=IDN LET Vi(4)=1 ! MAT m=ROTATE(PI/2)*SCALE(1/SQR(3))*SHIFT(1/2,TAN(PI/6)/2) !底辺(0,0)~(1,0) CALL polygon(3, p3) !正３角形 MAT m=ROTATE(PI/2)*SHIFT(SIN(PI/5),COS(PI/5))*SCALE(0.5/SIN(PI/5)) !底辺(0,0)~(1,0) CALL polygon(5, p5) !正５角形 MAT m=SCALE(1/3)*SHIFT(1/2,TAN(PI/6)/2) !底辺(1/3,0)~(2/3,0) CALL polygon(6, p6) !正６角形 SUB polygon(n, p(,)) FOR i=0 TO n LET Vi(1)=COS(2*PI*i/n) LET Vi(2)=SIN(2*PI*i/n) !頂点半径=1 IF i=0 THEN LET Vi(1)=0 !p(0,1~)=中心点(重心), p(1,1~) ~p(n,1~)=頂点座標 MAT Vo=Vi*m LET p(i,1)=Vo(1) LET p(i,2)=Vo(2) NEXT i END SUB CALL mat_rotx1(-PI/4) !見下ろし角 DO SET DRAW mode hidden CLEAR PLOT label,AT -.5,2:"左クリック一時停止。　右クリック終了。" LET sq=0 SELECT CASE IP(s) CASE 0 TO 3 CALL mat_rotx2(PI/4.815) !4.810~4.820　切頭部５角～残部６角折り角 CALL mat_rotx(PI/4.305) !３２面体 !4.304~4.306　　残部６角～残部６角折り角 DRAW D32(5) WITH SHIFT(-.5,-SQR(3)/6)*ROTATE(rx)*rotx1 IF IP(s)=0 THEN CALL priority(5) IF IP(s)=1 THEN CALL priority(6) IF IP(s)=2 THEN CALL priority(2) IF IP(s)=3 THEN CALL priority(7) CASE 4 TO 5 CALL mat_rotx(PI/4.305) !正２０面体 !4.303~4.305 DRAW D20(5) WITH SHIFT(-.5,-SQR(3)/6)*ROTATE(rx)*rotx1 IF IP(s)=4 THEN CALL priority(0) IF IP(s)=5 THEN CALL priority(2) CASE 6 TO 7 CALL mat_rotx(PI/2.8376) !正１２面体 !2.8375~2.8378 DRAW D12(4) WITH SHIFT(-.5,-SQR(3)/2)*ROTATE(rx)*rotx1*SCALE(.7) IF IP(s)=6 THEN CALL priority(0) IF IP(s)=7 THEN CALL priority(2) CASE 8 TO 9 CALL mat_rotx(PI/2.552) !正８面体 !2.550~2.552 DRAW D20(3) WITH SHIFT(-.5,-SQR(3)/6)*ROTATE(rx)*rotx1*SCALE(1.4) IF IP(s)=8 THEN CALL priority(0) IF IP(s)=9 THEN CALL priority(2) CASE 10 TO 11 CALL mat_rotx(PI/1.644) !正４面体 !1.641~1.646~7 DRAW D20(2) WITH SHIFT(-.5,-SQR(3)/6)*ROTATE(rx)*rotx1*SCALE(1.4) IF IP(s)=10 THEN CALL priority(0) IF IP(s)=11 THEN CALL priority(2) CASE ELSE LET s=-0.04 END SELECT SET DRAW mode explicit LET s=s+0.04 LET rx=rx+PI/64 DO mouse poll mx,my,mlb,mrb WAIT DELAY .05 LOOP UNTIL mlb=0 OR mrb=1 LOOP UNTIL mrb=1 SUB priority( flg) !paint flg( 0=even_ib 1=odd_ib 2=all_ib 5=only5 6=only6) IF sq1<>sq THEN PRINT sq LET sq1=sq END IF FOR j=1 TO sq !z 最小(奥) から描く。 LET z=1e9 FOR i=1 TO sq IF D3(i,0,3)< z THEN LET z=D3(i,0,3) LET ib=i END IF NEXT i LET D3(ib,0,3)=1e9 SET AREA COLOR ib+1 IF D3(ib,6,1)=3e9 THEN IF MOD(ib,2)=flg OR flg=2 THEN PLOT AREA :D3(ib,1,1),D3(ib,1,2);D3(ib,2,1),D3(ib,2,2);D3(ib,3,1),D3(ib,3,2);D3(ib,1,1),D3(ib,1,2) PLOT LINES:D3(ib,1,1),D3(ib,1,2);D3(ib,2,1),D3(ib,2,2);D3(ib,3,1),D3(ib,3,2);D3(ib,1,1),D3(ib,1,2) ELSEIF D3(ib,6,1)=5e9 THEN IF flg=7 THEN SET AREA COLOR 1 IF MOD(ib,2)=flg OR flg=2 OR flg=5 OR flg=7 THEN PLOT AREA :D3(ib,1,1),D3(ib,1,2);D3(ib,2,1),D3(ib,2,2);D3(ib,3,1),D3(ib,3,2);D3(ib,4,1),D3(ib,4,2);D3(ib,5,1),D3(ib,5,2);D3(ib,1,1),D3(ib,1,2) PLOT LINES:D3(ib,1,1),D3(ib,1,2);D3(ib,2,1),D3(ib,2,2);D3(ib,3,1),D3(ib,3,2);D3(ib,4,1),D3(ib,4,2);D3(ib,5,1),D3(ib,5,2);D3(ib,1,1),D3(ib,1,2) ELSE IF flg=7 THEN SET AREA COLOR 0 IF MOD(ib,2)=flg OR flg=2 OR flg=6 OR flg=7 THEN PLOT AREA :D3(ib,1,1),D3(ib,1,2);D3(ib,2,1),D3(ib,2,2);D3(ib,3,1),D3(ib,3,2);D3(ib,4,1),D3(ib,4,2);D3(ib,5,1),D3(ib,5,2);D3(ib,6,1),D3(ib,6,2);D3(ib,1,1),D3(ib,1,2) PLOT LINES:D3(ib,1,1),D3(ib,1,2);D3(ib,2,1),D3(ib,2,2);D3(ib,3,1),D3(ib,3,2);D3(ib,4,1),D3(ib,4,2);D3(ib,5,1),D3(ib,5,2);D3(ib,6,1),D3(ib,6,2);D3(ib,1,1),D3(ib,1,2) END IF NEXT j END SUB SUB getpos(n, p(,)) LET sq=sq+1 MAT m=TRANSFORM FOR j=0 TO n LET Vi(1)=p(j,1) LET Vi(2)=p(j,2) MAT Vo=Vi*m LET D3(sq,j,1)=Vo(1) LET D3(sq,j,2)=Vo(2) LET D3(sq,j,3)=Vo(3) NEXT j IF n< 6 THEN LET D3(sq,6,1)=n*1e9 FOR i=1 TO sq-1 IF (D3(i,0,1)-D3(sq,0,1))^2+(D3(i,0,2)-D3(sq,0,2))^2+(D3(i,0,3)-D3(sq,0,3))^2< .05 THEN EXIT FOR !<=.21 NEXT i IF i< sq THEN LET sq=sq-1 !重複画の除去 END SUB PICTURE D32(k) IF 0< k THEN DRAW D32(k-1) WITH rotx*ROTATE(-PI/3)*SHIFT(1/2,SIN(PI/3)) !右上６角 DRAW D32(k-1) WITH rotx*ROTATE(PI/3) !左上６角 DRAW D325 WITH SCALE(1/3)*rotx2*SHIFT(1/3,SQR(3)/3) !　上５角 END IF CALL getpos(6, p6) !　基６角 END PICTURE PICTURE D325 CALL getpos(5, p5) !　基５角 END PICTURE PICTURE D20(k) IF 0< k THEN DRAW D20(k-1) WITH rotx*ROTATE(-PI/3)*SHIFT(1/2,SIN(PI/3)) !右上３角 DRAW D20(k-1) WITH rotx*ROTATE(PI/3) !左上３角 END IF CALL getpos(3, p3) !　基３角 END PICTURE PICTURE D12(k) IF 0< k THEN DRAW D12(k-1) WITH rotx*ROTATE(-PI/5)*SHIFT(1/2,TAN(PI*.3)/2+.5/SIN(PI/5)) !右上５角 DRAW D12(k-1) WITH rotx*ROTATE(PI/5)*SHIFT(-COS(PI*2/5),SIN(PI*2/5)) !左上５角 END IF CALL getpos(5, p5) !　基５角 END PICTURE !--------------------------------- !ｘ軸を、軸として回転する行列 rotx !(x,y,z,1)| 1, 0, 0, 0 | ! | 0, cos(a), sin(a), 0 | ! | 0,-sin(a), cos(a), 0 | ! | 0, 0, 0, 1 | !--------------------------------- SUB mat_rotx(a) LET rotx(2,2)=COS(a) LET rotx(3,2)=-SIN(a) LET rotx(2,3)=SIN(a) LET rotx(3,3)=COS(a) END SUB SUB mat_rotx1(a) LET rotx1(2,2)=COS(a) LET rotx1(3,2)=-SIN(a) LET rotx1(2,3)=SIN(a) LET rotx1(3,3)=COS(a) END SUB SUB mat_rotx2(a) LET rotx2(2,2)=COS(a) LET rotx2(3,2)=-SIN(a) LET rotx2(2,3)=SIN(a) LET rotx2(3,3)=COS(a) END SUB END

Re: 自己相似写像で描く多面体

投稿者：SECOND 投稿日：2011年 7月17日(日)04時25分24秒

> No.1595[元記事へ] !自己相似写像で描く !正多面体(4,8,12,20)と、切頂20面体( 32面体・フラーレン・サッカーボール) !３）組立から、展開図へのアニメ－ション。 !--------------------------------------------------------- !折り角を開いて展開図にする時、辺と辺が接合する展開になる様に、 !写像の階数を、開始時に指定しないで、重複画が生じるまでを階数として !連続させ、階数は、分岐路ごと、一律でないような方法に変更した。 OPTION ARITHMETIC NATIVE SET TEXT JUSTIFY "center","half" SET WINDOW -1.5, 1.5, -.75, 2.25 DIM rotx(4,4), rotx1(4,4), rotx2(4,4), Axys(4,4) DIM Vi(4), Vo(4), m(4,4), D3( 32+1, 0 TO 6, 3), D3_(5, 0 TO 100) DIM p3(0 TO 3, 2), p5(0 TO 5, 2), p6(0 TO 6, 2) ! MAT rotx=IDN MAT rotx1=IDN MAT rotx2=IDN MAT Axys=IDN LET Vi(4)=1 ! LET ir3=TAN(PI/6)/2 !inscribed radius MAT m=ROTATE(PI/2)*SCALE(1/SQR(3)) !中心(0,0)底辺(-.5,-ir3)~(.5,-ir3) CALL polygon(3, p3) !正３角形 ! LET ir5=TAN(.3*PI)/2 !inscribed radius MAT m=ROTATE(PI/2)*SCALE(0.5/SIN(PI/5)) !中心(0,0)底辺(-.5,-ir5)~(.5,-ir5) CALL polygon(5, p5) !正５角形 ! LET ir6=TAN(PI/6)/2 !inscribed radius MAT m=SCALE(1/3) !中心(0,0)底辺(-1/6,-ir6)~(1/6,-ir6) CALL polygon(6, p6) !正６角形 ! CALL setup SUB polygon(n, p(,)) FOR i=0 TO n LET Vi(1)=COS(2*PI*i/n) LET Vi(2)=SIN(2*PI*i/n) !頂点半径=1 IF i=0 THEN LET Vi(1)=0 !p(0,1~)=中心点(重心), p(1,1~) ~p(n,1~)=頂点座標 MAT Vo=Vi*m LET p(i,1)=Vo(1) LET p(i,2)=Vo(2) NEXT i END SUB SUB setup !採取画順位を、D3_(,) に記憶 FOR item=1 TO 5 LET sq=0 LET sq0=0 SELECT CASE item CASE 1 CALL mat_rotx(PI/4.305) !３２面体 !　残部６角～残部６角折り角 CALL mat_rotx2(PI/4.815) !切頭部５角～残部６角折り角 DRAW D32 CASE 2 CALL mat_rotx(PI/4.305) !正２０面体 DRAW D20 CASE 3 CALL mat_rotx(PI/2.8376) !正１２面体 DRAW D12 CASE 4 CALL mat_rotx(PI/2.552) !正８面体 DRAW D20 CASE 5 CALL mat_rotx(PI/1.644) !正４面体 DRAW D20 END SELECT LET D3_(item,0)=item !採取画順位の記憶完了 NEXT item END SUB LET Ax=-PI/4 !常時回転軸( 画面に垂直が０度) のｘ軸回転 LET Ay=0 !　　〃　　〃　　　　　　　のｙ軸回転 LET op1=1 DO SET DRAW mode hidden CLEAR PLOT label,AT 0, 2.17:"左 click 一時停止、drag 軸傾斜。右 click 終了" LET sq=0 LET sq0=0 ! ! ※平面展開図が不要な場合、下の６行を取外すと回転軸の、自由なドラッグが可能。 !================================================================================= CALL flatx( 1, -PI/6, -.56,-1.5, 2.4) !(s0,rx,x0,y0,hw) !平面展開図セットアップ CALL flatx( 3, -PI/6, -.56,-1.5, 2.4) !(s0,rx,x0,y0,hw) !　　〃 CALL flatx( 5, PI/12, -1.3,-2, 3) !(s0,rx,x0,y0,hw) !　　〃 CALL flatx( 7, 1.28*PI,-2.1,-2.3, 3.1) !(s0,rx,x0,y0,hw) !　　〃 CALL flatx( 9, -PI/1.7,-1.4,-1.4, 2.4) !(s0,rx,x0,y0,hw) !　　〃 CALL flatx(11, -PI/1.2,-.9,-.8, 2) !(s0,rx,x0,y0,hw) !　　〃 !================================================================================= ! SELECT CASE s CASE 0 TO 3 LET item=1 CALL drag_click CALL mat_rotx(op1*PI/4.305) !３２面体　　残部６角～残部６角折り角 CALL mat_rotx2(op1*PI/4.815) !　　　　　切頭部５角～残部６角折り角 DRAW D32 WITH ROTATE(rx)*Axys IF s< 2 THEN CALL priority(2) ELSE CALL priority(7) CASE 4 TO 5 LET item=2 CALL drag_click CALL mat_rotx(op1*PI/4.305) !正２０面体　３角～３角折り角 DRAW D20 WITH ROTATE(rx)*Axys CALL priority(2) CASE 6 TO 7 LET item=3 CALL drag_click CALL mat_rotx(op1*PI/2.8376) !正１２面体　５角～５角折り角 DRAW D12 WITH ROTATE(rx)*Axys*SCALE(.65) CALL priority(2) CASE 8 TO 9 LET item=4 CALL drag_click CALL mat_rotx(op1*PI/2.552) !正８面体　　３角～３角折り角 DRAW D20 WITH ROTATE(rx)*Axys*SCALE(1.4) CALL priority(2) CASE 10 TO 11 LET item=5 CALL drag_click CALL mat_rotx(op1*PI/1.644) !正４面体　　３角～３角折り角 DRAW D20 WITH ROTATE(rx)*Axys*SCALE(1.5) CALL priority(2) CASE ELSE LET s=0 END SELECT SET DRAW mode explicit mouse poll mx,my,mlb,mrb IF mlb=0 THEN LET rx=rx+PI/64 LET sx=sx+PI/48 LET op1=(COS(sx)+1)/2 IF op1=1 THEN LET s=s+1 END IF WAIT DELAY .05 LOOP UNTIL mrb=1 SUB flatx(s0,r,x0,y0,hw) IF s=s0 THEN LET rx=r ! LET op1=0 !この行を有効にすると、※展開図が必要な場合、のアニメ停止、静止画(数秒) MAT Axys=IDN SET WINDOW x0-hw,x0+hw,y0-hw,y0+hw DRAW grid ELSEIF s=s0+1 AND op1=1 THEN SET WINDOW -1.5, 1.5, -.75, 2.25 LET Ax=-PI/4 END IF END SUB SUB drag_click mouse poll mx,my,mlb,mrb IF mlb=1 THEN LET Ax= -(my-mybak)*PI/3 !ドラッグ方向、*(π/2)／画面半幅 LET Ay= +(mx-mxbak)*PI/3 END IF LET mxbak=mx LET mybak=my !------- LET ar0=SQR(Ax^2+Ay^2) !旋回角度(∝マウス・ドラッグの長さ) IF ar0<>0 THEN LET DIRar0=ANGLE(Ax,Ay) !旋回軸の方向 CALL mat_rotx1(ar0) MAT Axys=Axys*ROTATE(-DIRar0)*rotx1*ROTATE(DIRar0) LET Ax=0 LET Ay=0 END IF !-----host using style !draw picture WITH ROTATE(custom_Az)*Axys ! END SUB SUB priority( flg) !paint flg( 7=only_5_6_mono, Others=color) IF sqb<>sq THEN PRINT USING"## ###":sq,sq0 LET sqb=sq END IF FOR j=1 TO sq !z 最小(奥) から描く。 LET z=1e9 FOR i=1 TO sq IF D3(i,0,3)< z THEN LET z=D3(i,0,3) LET ib=i END IF NEXT i LET D3(ib,0,3)=1e9 SET AREA COLOR ib+1 ASK COLOR MIX(ib+1) r,g,b IF .3*r+.59*g+.11*b< .5 THEN SET TEXT COLOR 0 ELSE SET TEXT COLOR 1 IF D3(ib,6,1)=3e9 THEN !３角形 PLOT AREA :D3(ib,1,1),D3(ib,1,2);D3(ib,2,1),D3(ib,2,2);D3(ib,3,1),D3(ib,3,2);D3(ib,1,1),D3(ib,1,2) PLOT LINES:D3(ib,1,1),D3(ib,1,2);D3(ib,2,1),D3(ib,2,2);D3(ib,3,1),D3(ib,3,2);D3(ib,1,1),D3(ib,1,2) PLOT label,AT D3(ib,0,1),D3(ib,0,2):STR$(ib) ELSEIF D3(ib,6,1)=5e9 THEN !５角形 IF flg=7 THEN SET AREA COLOR 1 IF flg=7 THEN SET TEXT COLOR 0 PLOT AREA :D3(ib,1,1),D3(ib,1,2);D3(ib,2,1),D3(ib,2,2);D3(ib,3,1),D3(ib,3,2);D3(ib,4,1),D3(ib,4,2);D3(ib,5,1),D3(ib,5,2);D3(ib,1,1),D3(ib,1,2) PLOT LINES:D3(ib,1,1),D3(ib,1,2);D3(ib,2,1),D3(ib,2,2);D3(ib,3,1),D3(ib,3,2);D3(ib,4,1),D3(ib,4,2);D3(ib,5,1),D3(ib,5,2);D3(ib,1,1),D3(ib,1,2) PLOT label,AT D3(ib,0,1),D3(ib,0,2):STR$(ib) ELSE !６角形 IF flg=7 THEN SET AREA COLOR 0 IF flg=7 THEN SET TEXT COLOR 1 PLOT AREA :D3(ib,1,1),D3(ib,1,2);D3(ib,2,1),D3(ib,2,2);D3(ib,3,1),D3(ib,3,2);D3(ib,4,1),D3(ib,4,2);D3(ib,5,1),D3(ib,5,2);D3(ib,6,1),D3(ib,6,2);D3(ib,1,1),D3(ib,1,2) PLOT LINES:D3(ib,1,1),D3(ib,1,2);D3(ib,2,1),D3(ib,2,2);D3(ib,3,1),D3(ib,3,2);D3(ib,4,1),D3(ib,4,2);D3(ib,5,1),D3(ib,5,2);D3(ib,6,1),D3(ib,6,2);D3(ib,1,1),D3(ib,1,2) PLOT label,AT D3(ib,0,1),D3(ib,0,2):STR$(ib) END IF NEXT j SET TEXT COLOR 1 END SUB SUB getpos(n, p(,)) LET nst=0 LET sq0=sq0+1 IF 0< D3_(item,0) AND D3_(item,sq0)=0 THEN EXIT SUB LET nst=1 LET sq=sq+1 MAT m=TRANSFORM FOR j=0 TO n LET Vi(1)=p(j,1) LET Vi(2)=p(j,2) MAT Vo=Vi*m LET D3(sq,j,1)=Vo(1) LET D3(sq,j,2)=Vo(2) LET D3(sq,j,3)=Vo(3) NEXT j IF n< 6 THEN LET D3(sq,6,1)=n*1e9 IF 0< D3_(item,0) THEN EXIT SUB FOR i=1 TO sq-1 IF (D3(i,0,1)-D3(sq,0,1))^2+(D3(i,0,2)-D3(sq,0,2))^2+(D3(i,0,3)-D3(sq,0,3))^2< .05 THEN EXIT FOR !<=.21 NEXT i IF sq<=i THEN LET D3_(item,sq0)=sq !採取画順位の記憶 ELSE LET sq=sq-1 !重複画の除去 LET nst=0 END IF END SUB PICTURE D32 DRAW D325 WITH SHIFT(0,ir5)*SCALE(1/3)*rotx2*SHIFT(0,ir6)*ROTATE(-PI*2/3) !右下５角 CALL getpos(6, p6) !　基６角 DRAW D325 WITH SHIFT(0,ir5)*SCALE(1/3)*rotx2*SHIFT(0,ir6) !　上５角 IF 0< nst THEN DRAW D32 WITH SHIFT(0,ir6)*rotx*SHIFT(0,ir6)*ROTATE(-PI/3) !右上６角 DRAW D32 WITH SHIFT(0,ir6)*rotx*SHIFT(0,ir6)*ROTATE(PI/3) !左上６角 END IF END PICTURE PICTURE D325 CALL getpos(5, p5) !　基５角 END PICTURE PICTURE D20 CALL getpos(3, p3) !　基３角 IF 0< nst THEN DRAW D20 WITH SHIFT(0,ir3)*rotx*SHIFT(0,ir3)*ROTATE(-PI/3) !右上３角 DRAW D20 WITH SHIFT(0,ir3)*rotx*SHIFT(0,ir3)*ROTATE(PI/3) !左上３角 END IF END PICTURE PICTURE D12 CALL getpos(5, p5) !　基５角 IF 0< nst THEN DRAW D12 WITH SHIFT(0,ir5)*rotx*SHIFT(0,ir5)*ROTATE(-.2*PI) !右上５角 DRAW D12 WITH SHIFT(0,ir5)*rotx*SHIFT(0,ir5)*ROTATE(.2*PI) !左上５角 DRAW D12 WITH SHIFT(0,ir5)*rotx*SHIFT(0,ir5)*ROTATE(-.6*PI) !右下５角 END IF END PICTURE !--------------------------------- !ｘ軸を、軸として回転する行列 rotx !(x,y,z,1)| 1, 0, 0, 0 | ! | 0, cos(a), sin(a), 0 | ! | 0,-sin(a), cos(a), 0 | ! | 0, 0, 0, 1 | !--------------------------------- SUB mat_rotx(a) LET rotx(2,2)=COS(a) LET rotx(3,2)=-SIN(a) LET rotx(2,3)=SIN(a) LET rotx(3,3)=COS(a) END SUB SUB mat_rotx1(a) LET rotx1(2,2)=COS(a) LET rotx1(3,2)=-SIN(a) LET rotx1(2,3)=SIN(a) LET rotx1(3,3)=COS(a) END SUB SUB mat_rotx2(a) LET rotx2(2,2)=COS(a) LET rotx2(3,2)=-SIN(a) LET rotx2(2,3)=SIN(a) LET rotx2(3,3)=COS(a) END SUB END !※平面展開図が不要な場合、マークのある６行を取外すと、回転軸の自由なドラッグが可能。

戻る

十進BASIC 第2掲示板 過去ログ

自己相似写像で描く 多面体

Re: 自己相似写像で描く 多面体

Re: 自己相似写像で描く 多面体

十進BASIC 第2掲示板過去ログ

自己相似写像で描く多面体

Re: 自己相似写像で描く多面体

Re: 自己相似写像で描く多面体