リサージュ曲線 etc.

 投稿者：しばっち  投稿日：2011年 8月14日(日)23時29分30秒
  ※関数の周期(変数N)は考慮していない。(要)調整

OPTION BASE 0
LET LL=5 !'チューブ半径
LET NN=8 !'分割数
DIM X(7201),Y(7201),Z(7201),XN(NN),YN(NN),ZN(NN),XM(NN),YM(NN),ZM(NN)
RANDOMIZE
!'---------------------------------------------------
LET AA=INT(RND*20+1)
LET BB=INT(RND*20+1)
LET CC=INT(RND*20+1)
LET DD=INT(RND*10+1)
LET N=360
LET FF$="リサージュ曲線" & STR$(AA) & "_" & STR$(BB) & "_" & STR$(CC) & "_" & STR$(DD)
FOR I=0 TO N+1
   LET  X(I)=100*COS(AA*I*PI/180)
   LET  Z(I)=100*SIN(BB*I*PI/180)
   LET  Y(I)=100*SIN(CC*I*PI/180+DD*PI/2)
NEXT I
!'---------------------------------------------------
!'LET DD=INT(RND*5+1)
!'LET CC=INT(RND*200+1)
!'LET BB=INT(RND*200+1)
!'LET AA=INT(RND*100+1)+BB  !'BB<AA
!'LET N=360*10
!'LET FF$="内トロコイド曲線" & STR$(AA) & "_" & STR$(BB) & "_" & STR$(CC) & "_" & STR$(DD)
!'FOR I=0 TO N+1
!'   LET  X(I)=(AA-BB)*COS(I*PI/180)+CC*COS((AA-BB)/BB*I*PI/180) !'スピログラフ
!'   LET  Y(I)=(AA-BB)*SIN(DD*I*PI/180)
!'   LET  Z(I)=(AA-BB)*SIN(I*PI/180)-CC*SIN((AA-BB)/BB*I*PI/180)
!'NEXT I
!'---------------------------------------------------
!'LET AA=INT(RND*100+1)
!'LET BB=INT(RND*200+1)+AA  !'AA<BB
!'LET CC=INT(RND*200+1)
!'LET DD=INT(RND*5+1)
!'LET N=360*10
!'LET FF$="外トロコイド曲線" & STR$(AA) & "_" & STR$(BB) & "_" & STR$(CC) & "_" & STR$(DD)
!'FOR I=0 TO N+1
!'   LET  X(I)=(AA+BB)*COS(I*PI/180)-CC*COS((AA+BB)/BB*I*PI/180)
!'   LET  Z(I)=(AA+BB)*SIN(I*PI/180)-CC*SIN((AA+BB)/BB*I*PI/180)
!'   LET  Y(I)=(AA+BB)*SIN(DD*I*PI/180)
!'NEXT I
!'---------------------------------------------------
!'LET AA=INT(RND*20+1)
!'LET BB=INT(RND*20+1)
!'LET N=360
!'LET FF$="バラ曲線" & STR$(AA) & "_" & STR$(BB)
!'FOR I=0 TO N+1
!'   LET  R=150*COS(I*PI/180*AA)*COS(I*PI/180*BB)
!'   LET  X(I)=R*COS(I*PI/180)*COS(I*PI/180)
!'   LET  Z(I)=R*COS(I*PI/180)*SIN(I*PI/180)
!'   LET  Y(I)=R*SIN(I*PI/180)
!'NEXT I
!'---------------------------------------------------
!'LET AA=INT(RND*20+1)
!'LET BB=INT(RND*20+1)
!'LET N=360
!'LET FF$="球面模様" & STR$(AA) & "_" & STR$(BB)
!'FOR I=0 TO N+1
!'   LET  X(I)=100*SIN(AA*I*PI/180)*COS(BB*I*PI/180)
!'   LET  Z(I)=100*SIN(AA*I*PI/180)*SIN(BB*I*PI/180)
!'   LET  Y(I)=100*COS(AA*I*PI/180)
!'NEXT I
!'---------------------------------------------------
!'LET  N=360*5
!'LET FF$="円柱螺旋"
!'FOR I=0 TO N+1
!'   LET  X(I)=I/36*COS(I*PI/180)+.5
!'   LET  Z(I)=I/36*SIN(I*PI/180)+.5
!'   LET  Y(I)=(I/144)^2+.5
!'NEXT I
!'---------------------------------------------------
!'LET AA=INT(RND*20+1)
!'LET BB=INT(RND*20+1)
!'LET N=360*15
!'LET FF$="球面螺旋" & STR$(AA) & "_" & STR$(BB)
!'FOR I=0 TO N+1
!'   LET  X(I)=100*COS(I*PI/180)*SIN(I*PI/180*BB/AA)
!'   LET  Z(I)=100*SIN(I*PI/180)*SIN(I*PI/180*BB/AA)
!'   LET  Y(I)=100*COS(I*PI/180*BB/AA)
!'NEXT I
!'---------------------------------------------------
!'LET N=360*5
!'LET FF$="円錐螺旋"
!'FOR I=0 TO N+1
!'   LET  X(I)=I/36*COS(I*PI/180)+.5
!'   LET  Z(I)=I/36*SIN(I*PI/180)+.5
!'   LET  Y(I)=I/18+.5
!'NEXT I
!'---------------------------------------------------
!'LET N=360*5
!'LET FF$="香取線香"
!'FOR I=0 TO N+1
!'   LET  X(I)=(50-I/36)*COS(I*PI/180)
!'   LET  Z(I)=(50-I/36)*SIN(I*PI/180)
!'   LET  Y(I)=SQR(I/36)
!'NEXT I
!'---------------------------------------------------
!'LET N=360*10
!'LET FF$="バネ状トーラス"
!'FOR I=0 TO N+1
!'   LET  X(I)=(25+12*COS(1.11*I*PI/180))*COS(0.1*I*PI/180)
!'   LET  Z(I)=(25+12*SIN(1.11*I*PI/180))*SIN(0.1*I*PI/180)
!'   LET  Y(I)=12*SIN(1.11*I*PI/180)
!'NEXT I
!'---------------------------------------------------
!'LET  N=360*20
!'LET FF$="手まり"
!'FOR I=0 TO N+1
!'   LET  X(I)=100*SIN(1.11*I*PI/180)*COS(I*PI/180)
!'   LET  Z(I)=100*SIN(1.11*I*PI/180)*SIN(I*PI/180)
!'   LET  Y(I)=100*COS(1.11*I*PI/180)
!'NEXT I
FILE GETSAVENAME F$,"dxfファイル|*.dxf"
IF F$="" THEN STOP
IF RIGHT$(F$,1)="!" THEN LET F$=F$(1:LEN(F$)-1) & FF$
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"
FOR I=0 TO N
   LET  XA=X(I+1)-X(I)
   LET  YA=Y(I+1)-Y(I)
   LET  ZA=Z(I+1)-Z(I)
   LET  VX=Y(I+1)*Z(I)-Z(I+1)*Y(I)
   LET  VY=Z(I+1)*X(I)-X(I+1)*Z(I)
   LET  VZ=X(I+1)*Y(I)-Y(I+1)*X(I)
   LET  SS=SQR(VX^2+VY^2+VZ^2)
   IF SS=0 THEN
      LET  VX=(Y(I+1)+1)*(Z(I)+1)-(Z(I+1)+1)*(Y(I)+1)
      LET  VY=(Z(I+1)+1)*(X(I)+1)-(X(I+1)+1)*(Z(I)+1)
      LET  VZ=(X(I+1)+1)*(Y(I)+1)-(Y(I+1)+1)*(X(I)+1)
      LET  SS=SQR(VX^2+VY^2+VZ^2)
   END IF
   LET  VX=VX/SS
   LET  VY=VY/SS
   LET  VZ=VZ/SS
   LET  TX=XA+VX*LL
   LET  TY=YA+VY*LL
   LET  TZ=ZA+VZ*LL
   FOR K=0 TO NN-1
      CALL QUATERNIONROT(TX,TY,TZ,XA,YA,ZA,360-K*360/NN,XO,YO,ZO)
      LET XN(K)=XO+X(I)
      LET YN(K)=YO+Y(I)
      LET ZN(K)=ZO+Z(I)
   NEXT K
   IF I>0 THEN
      FOR K=0 TO NN-1
         PRINT #1:"0"
         PRINT #1:"3DFACE"
         PRINT #1:"8"
         PRINT #1:"LAYER1"
         PRINT #1:"62"
         PRINT #1:"1"
         PRINT #1:"10"
         PRINT #1:XM(K)
         PRINT #1:"20"
         PRINT #1:YM(K)
         PRINT #1:"30"
         PRINT #1:ZM(K)
         PRINT #1:"11"
         IF K=NN-1 THEN PRINT #1:XM(0) ELSE PRINT #1:XM(K+1)
         PRINT #1:"21"
         IF K=NN-1 THEN PRINT #1:YM(0) ELSE PRINT #1:YM(K+1)
         PRINT #1:"31"
         IF K=NN-1 THEN PRINT #1:ZM(0) ELSE PRINT #1:ZM(K+1)
         PRINT #1:"12"
         IF K=NN-1 THEN PRINT #1:XN(0) ELSE PRINT #1:XN(K+1)
         PRINT #1:"22"
         IF K=NN-1 THEN PRINT #1:YN(0) ELSE PRINT #1:YN(K+1)
         PRINT #1:"32"
         IF K=NN-1 THEN PRINT #1:ZN(0) ELSE PRINT #1:ZN(K+1)
         PRINT #1:"13"
         PRINT #1:XN(K)
         PRINT #1:"23"
         PRINT #1:YN(K)
         PRINT #1:"33"
         PRINT #1:ZN(K)
      NEXT  K
   END IF
   MAT XM=XN
   MAT YM=YN
   MAT ZM=ZN
NEXT I
PRINT #1:"0"
PRINT #1:"ENDSEC"
PRINT #1:"0"
PRINT #1:"EOF"
CLOSE #1
END

EXTERNAL  SUB QUATERNIONROT(X,Y,Z,XA,YA,ZA,THETA,XX,YY,ZZ)
!'任意軸回転 点 P(X,Y,Z) 回転軸(XA,YA,ZA) 回転後 P'(XX,YY,ZZ)
OPTION BASE 0
DIM Q(4),IQ(4),P(4),S(4),T(4)
LET  R=SQR(XA*XA+YA*YA+ZA*ZA)
LET  XB=XA/R
LET  YB=YA/R
LET  ZB=ZA/R
LET  Q(0)=COS(THETA/2*PI/180)
LET  Q(1)=SIN(THETA/2*PI/180)*XB
LET  Q(2)=SIN(THETA/2*PI/180)*YB
LET  Q(3)=SIN(THETA/2*PI/180)*ZB
LET  P(0)=0
LET  P(1)=X
LET  P(2)=Y
LET  P(3)=Z
CALL QUATERNIONINV(Q,IQ)
CALL QUATERNIONMUL(Q,P,S)
CALL QUATERNIONMUL(S,IQ,T)
LET  XX=T(1)
LET  YY=T(2)
LET  ZZ=T(3)
END SUB

EXTERNAL  SUB QUATERNIONINV(QI(),QO())
LET  QO(0)=QI(0)
LET  QO(1)=-QI(1)
LET  QO(2)=-QI(2)
LET  QO(3)=-QI(3)
END SUB

EXTERNAL  SUB QUATERNIONMUL(A(),B(),S())
LET S(0)=A(0)*B(0)-A(1)*B(1)-A(2)*B(2)-A(3)*B(3)
LET S(1)=A(0)*B(1)+A(1)*B(0)+A(2)*B(3)-A(3)*B(2)
LET S(2)=A(0)*B(2)-A(1)*B(3)+A(2)*B(0)+A(3)*B(1)
LET S(3)=A(0)*B(3)+A(1)*B(2)-A(2)*B(1)+A(3)*B(0)
END SUB

リサージュ曲線 (AA=9,BB=7,CC=16,DD=6)
 

戻る