作図ツール（Geometric Constructor）

 投稿者：山中和義  投稿日：2010年12月19日(日)14時43分8秒
  図形とベクトル方程式　※修正2010.12.23


!作図ツール（Geometric Constructor）

!●平面の点を「平面のベクトルとみる」と「複素数とみる」と考えられる
OPTION ARITHMETIC COMPLEX

SET WINDOW -8,8,-8,8 !表示領域を設定する　※
DRAW grid !XY座標

PUBLIC NUMERIC cEps !精度　※調整が必要である
LET cEps=1e-8

PUBLIC NUMERIC gcCOLOR,gcSTYLE !描画色、点の形状
LET gcCOLOR=1
LET gcSTYLE=1
!------------------------------ ここまでがサブルーチン


!●三角形ABCの九点円
!・３辺の中点、各頂点から下ろした垂線の足、垂心と各頂点を結ぶ線分の中点を通る
!・中心は、外心と垂心の中点。半径は、外接円の半径の半分

LET OA=v(2,6) !三角形ABCの頂点
LET OB=v(-5,-5)
LET OC=v(7,-3)

!三角形ABC心
CALL gcCIRCUMCENTER(OA,OB,OC,"", Ox,R) !外心
CALL gcGRAVITY(OA,OB,OC,"", OG) !重心
CALL gcORTHOCENTER(OA,OB,OC,"", OH) !垂心

!各辺の中点
CALL gcCENTER(OB,OC,"D", OD)
CALL gcCENTER(OC,OA,"E", OE)
CALL gcCENTER(OA,OB,"F", OF)

!各頂点から下ろした垂線の足
LET gcCOLOR=2
CALL gcPERPENDICULAR(OA,OB,OC,"K", OK)
CALL gcPERPENDICULAR(OB,OC,OA,"L", OL)
CALL gcPERPENDICULAR(OC,OA,OB,"M", OM)

!垂心と各頂点を結ぶ線分の中点
LET gcCOLOR=3
CALL gcCENTER(OA,OH,"P", OP)
CALL gcCENTER(OB,OH,"Q", OQ)
CALL gcCENTER(OC,OH,"R", OR)

!三角形ABC
LET gcCOLOR=1
CALL gcTRIANGLE(OA,OB,OC,"ABC", a,b,c,S)



!九点円の性質
LET ON=(Ox+OH)/2 !中心
LET gcCOLOR=4
CALL gcCIRCLE(ON,R/2,"N") !九心円を描く

!４点Q,G,N,Hは同一直線上にある。この直線のことを、オイラー線という。線分の比は、
LET xG=OG-Ox
LET GN=ON-OG
LET NH=OH-ON
LET t=ABS(GN)
PRINT ABS(xG)/t; ABS(GN)/t; ABS(NH)/t !2:1:3

CALL gcLINE(Ox,OH,"")


END


!作図ツール（Geometric Constructor）

!図形とベクトル方程式
!　平面の点を「平面のベクトルとみる」と「複素数とみる」と考えられる

!機能
!・点
!　　任意の位置、中点*、内分・外分する点、ｎ等分
!　　交点
!　　　２直線、直線と円、２円
!・直線
!　　直線ABに平行で点Pを通る、直線ABに垂直で点Pを通る*、垂直二等分線
!　　水平線*、垂直線*
!・線分
!　　２点を結ぶ、垂線の足、点Pから線分ABへの中線*
!　　接線
!　　　円周上の点における接線、点Pからの接線、２円の共通接線
!・半直線
!　　直線ABに平行で点Pを通る、角の二等分線
!・多角形
!　　三角形
!　　正ｎ角形
!　　　１頂点と半径、１辺
!・円
!　　円周上の点と半径*、中心と半径、中心と直径*、円周上の２点と半径、円周上の３点*
!・計測
!　　点と点との距離、なす角、点と直線との距離（垂線の長さ）


!●複素数による平面上のベクトルの計算

EXTERNAL FUNCTION v(a,b) !複素数の和差、実数倍の計算を対応させる
OPTION ARITHMETIC COMPLEX
LET v=COMPLEX(a,b)
!絶対値　ベクトル |a|^2=a・a　　複素数 |z|^2=z*conj(z)
END FUNCTION


EXTERNAL FUNCTION fnDOT(a,b) !内積　a1*b1+a2*b2
OPTION ARITHMETIC COMPLEX
LET fnDOT=Re(a)*Re(b)+Im(a)*Im(b)
END FUNCTION

EXTERNAL FUNCTION fnCROSS(a,b) !擬似外積　a1*b2-a2*b1
OPTION ARITHMETIC COMPLEX
LET fnCROSS=Re(a)*Im(b)-Im(a)*Re(b)
END FUNCTION

EXTERNAL FUNCTION fnANGLE(a,b) !なす角
OPTION ARITHMETIC COMPLEX
IF Re(b/a)=0 AND Im(b/a)=0 THEN
   LET fnANGLE=0
ELSE
   LET fnANGLE=ANGLE(Re(b/a),Im(b/a))
END IF
END FUNCTION

EXTERNAL FUNCTION fnROTATE(a,th) !原点での反時計まわりの回転
OPTION ARITHMETIC COMPLEX
LET fnROTATE=v(COS(th),SIN(th))*a
!　複素数 cosΘ+i*sinΘ を行列表現すると
!　┌ cosΘ -sinΘ ┐
!　└ sinΘ  cosΘ ┘
!オイラーの公式 cosΘ+i*sinΘ=Exp(i*Θ) である。
END FUNCTION

EXTERNAL FUNCTION fnNormalize(a) !正規化 a/|a|
OPTION ARITHMETIC COMPLEX
IF ABS(a)<>0 THEN LET fnNormalize=a/ABS(a)
END FUNCTION



!●定木とコンパスによる描画

!●点

EXTERNAL SUB gcDOT(OA,N$) !点Aを描く
OPTION ARITHMETIC COMPLEX
SET AREA COLOR gcCOLOR
SET LINE COLOR gcCOLOR
SELECT CASE gcSTYLE !点の形状
CASE 1 !●
   DRAW disk WITH SCALE(0.2)*SHIFT(Re(OA),Im(OA))
CASE 2 !＋
   DRAW cross1 WITH SCALE(0.2)*SHIFT(Re(OA),Im(OA))
CASE 3 !＊
   DRAW star WITH SCALE(0.2)*SHIFT(Re(OA),Im(OA))
CASE 4 !○
   DRAW circle WITH SCALE(0.2)*SHIFT(Re(OA),Im(OA))
CASE 5 !×
   DRAW cross2 WITH SCALE(0.2)*SHIFT(Re(OA),Im(OA))
CASE 6 !■
   DRAW boxf WITH SCALE(0.2)*SHIFT(Re(OA),Im(OA))
CASE 7 !□
   DRAW box WITH SCALE(0.2)*SHIFT(Re(OA),Im(OA))
CASE ELSE
END SELECT
PLOT TEXT ,AT Re(OA)+0.2,Im(OA)+0.2: N$
END SUB

EXTERNAL PICTURE boxf !塗り潰し矩形
OPTION ARITHMETIC COMPLEX
PLOT AREA: -1,-1; 1,-1; 1,1; -1,1; -1,-1 !■
END PICTURE

EXTERNAL PICTURE box !矩形
OPTION ARITHMETIC COMPLEX
PLOT LINES: -1,-1; 1,-1; 1,1; -1,1; -1,-1 !□
END PICTURE

EXTERNAL PICTURE star !星印
OPTION ARITHMETIC COMPLEX
PLOT LINES: -1,-1; 1,1 !／
PLOT LINES: -1,1; 1,-1 !＼
PLOT LINES: 0,-1; 0,1 !｜
END PICTURE

EXTERNAL PICTURE cross1 !十字
OPTION ARITHMETIC COMPLEX
PLOT LINES: -1,0; 1,0 !─
PLOT LINES: 0,-1; 0,1 !｜
END PICTURE

EXTERNAL PICTURE cross2 !×印
OPTION ARITHMETIC COMPLEX
PLOT LINES: -1,-1; 1,1 !／
PLOT LINES: -1,1; 1,-1 !＼
END PICTURE


!分ける点

EXTERNAL SUB gcCENTER(OA,OB,N$, OC) !線分ABの中点
OPTION ARITHMETIC COMPLEX
LET OC=(OA+OB)/2
CALL gcDOT(OC,N$)
END SUB


EXTERNAL SUB gcDIVIDE(OA,OB,m,n,N$, OC) !線分ABをm:nに分ける点（内分・外分する点）
OPTION ARITHMETIC COMPLEX
LET OC=(n*OA+m*OB)/(m+n) !※外分m:nは、m:(-n)となる
CALL gcDOT(OC,N$)
END SUB


EXTERNAL SUB gcNDIVIDE(OA,OB,N,N$, OP()) !線分ABをｎ等分する点列
OPTION ARITHMETIC COMPLEX
LET l=ABS(OB-OA)
FOR i=1 TO N-1 !A,P1,P2,…,Pn-1,B
   LET OP(i)=l*i/N
   CALL gcDOT(OP(i),N$(i:i))
NEXT i
END SUB


続く
 

Re: 作図ツール（Geometric Constructor）

 投稿者：山中和義  投稿日：2010年12月19日(日)14時50分21秒
  > No.1471[元記事へ]

続き


!交点

EXTERNAL SUB gcINTERSECTION(OA,OB,OC,OD,N$, OP) !直線ABと直線CDとの交点
OPTION ARITHMETIC COMPLEX
LET AB=OB-OA
LET CD=OD-OC
LET DD=fnCross(CD,AB)
IF DD<>0 THEN
   LET AC=OC-OA
   LET OP=OA+( fnCross(CD,AC)/DD ) * AB !交点
   CALL gcDOT(OP,N$)
ELSE
   PRINT "平行です。"
   STOP
END IF
END SUB


EXTERNAL SUB gcINTERSECTION2(OA,OB,OC,OD,N$, OP) !線分ABと線分CDとの交点
OPTION ARITHMETIC COMPLEX
LET AB=OB-OA
LET d1=fnCross(AB,OC-OA)
LET d2=fnCross(AB,OD-OA)

LET CD=OD-OC
LET d3=fnCross(CD,OA-OC)
LET d4=fnCross(CD,OB-OC)

IF d1*d2<=0 AND d3*d4<=0 THEN
   LET OP=OA + ( ABS(d3)/(ABS(d3)+ABS(d4)) ) * AB !交点
   CALL gcDOT(OP,N$)
ELSE
   PRINT "交差なし"
   STOP
END IF
END SUB


EXTERNAL SUB gcINTERSECTION1C(OA,OB,OC,R,N$, OP,OQ,K) !直線ABと円Cの交点
OPTION ARITHMETIC COMPLEX
LET a=ABS(OC-OB) !線分BCの長さ
LET b=ABS(OA-OC) !線分CA
LET c=ABS(OB-OA) !線分AB

LET AH=(b^2+c^2-a^2)/(2*c) !AH=CA*cosAと余弦定理a^2=b^2+c^2-2*b*c*cosA
LET AB=c
LET OH=OA+(AH/AB)*(OB-OA) !垂線の足の位置ベクトル　↑OH=↑OA+↑AH=↑OA+t*↑ABより

LET CH=ABS(OH-OC) !円の中心と直線ABへの垂線の足との距離
IF R>=CH THEN
   LET nAB=fnNormalize(OB-OA) !単位方向ベクトル
   LET S=SQR(R^2-CH^2) !垂線の足と交点との距離
   LET OP=OH+S*nAB
   CALL gcDOT(OP,N$(1:1))
   LET OQ=OH-S*nAB
   CALL gcDOT(OQ,N$(2:2))
   IF S=0 THEN LET K=1 ELSE LET K=2 !１つ（接点）
ELSE
   PRINT "交わりません。"
   STOP
END IF
END SUB


EXTERNAL SUB gcINTERSECTION2C(OA,Ra,OB,Rb,N$, OP,OQ,K) !円Aと円Bの交点
OPTION ARITHMETIC COMPLEX
LET AB=OB-OA
LET L=ABS(AB)

LET t=(Ra^2-Rb^2+L^2)/(2*L)
LET a=ACOS(t/Ra) !↑PAと↑ABとの角度
LET a0=fnANGLE(v(1,0),AB) !↑ABの角度

IF L=ABS(Ra-Rb) OR L=Ra+Rb THEN !１つ（接点）
   LET OP=OA+fnROTATE(Ra,a0+a) !交点
   !!LET OP=OA+v(Ra*COS(a0+a),Ra*SIN(a0+a))
   CALL gcDOT(OP,N$(1:1))
   LET K=1
ELSEIF ABS(Ra-Rb)<L AND L<Ra+Rb THEN !２つ
   LET OP=OA+fnROTATE(Ra,a0+a) !交点
   LET OQ=OA+fnROTATE(Ra,a0-a)
   CALL gcDOT(OP,N$(1:1))
   CALL gcDOT(OQ,N$(2:2))
   LET K=2
ELSE
   PRINT "交わりません。"
   STOP
END IF
END SUB


!●直線

EXTERNAL SUB gcFLINE(OP,AB,N$) !点Pを通る、ベクトルABに平行な直線
OPTION ARITHMETIC COMPLEX
LET t=5 !t=[0,∞]　※範囲は調整が必要である
LET OQ=OP+AB*t
CALL gcLINE(OP,OQ,"")
LET OQ=OP+AB*(-t)
CALL gcLINE(OP,OQ,"")
CALL gcDOT(OP,N$)
END SUB


EXTERNAL SUB gcP2LINE(OA,OB, CP) !辺ABの垂直二等分線　→外心、外接円
OPTION ARITHMETIC COMPLEX
CALL gcCENTER(OA,OB,"", OC)

LET AB=OB-OA
LET CP=fnNormalize(v(-Im(AB),Re(AB))) !方向ベクトル（90度反時計回りに回転させる）

LET t=5 !t=[0,∞]　※範囲は調整が必要である
LET OP=OC+CP*(-t) !-90度
CALL gcLINE(OC,OP,"")

LET OP=OC+CP*t !90度
CALL gcLINE(OC,OP,"")
END SUB


EXTERNAL SUB gcXLINE(OP,N$) !点Pを通る水平線
OPTION ARITHMETIC COMPLEX
ASK WINDOW x1,x2,y1,y2
CALL gcLINE(v(x1,Im(OP)),v(x2,Im(OP)),"")
CALL gcDOT(OP,N$)
END SUB


EXTERNAL SUB gcYLINE(OP,N$) !点Pを通る垂直線
OPTION ARITHMETIC COMPLEX
ASK WINDOW x1,x2,y1,y2
CALL gcLINE(v(Re(OP),y1),v(Re(OP),y2),"")
CALL gcDOT(OP,N$)
END SUB


!●線分

EXTERNAL SUB gcLINE(OA,OB,N$) !始点と終点
OPTION ARITHMETIC COMPLEX
SET LINE COLOR gcCOLOR
PLOT LINES: Re(OA),Im(OA); Re(OB),Im(OB)
IF N$<>"" THEN !点を記入する
   CALL gcDOT(OA,N$(1:1)) !点Aを描く
   CALL gcDOT(OB,N$(2:2)) !点Bを描く
END IF
END SUB


EXTERNAL SUB gcLINE2(OA,TH,L,N$) !始点と角度と長さ
OPTION ARITHMETIC COMPLEX
LET OP=OA+v(COS(TH),SIN(TH))*L
CALL gcLINE(OA,OP,N$)
END SUB


EXTERNAL SUB gcPERPENDICULAR(OA,OB,OC,N$, OH) !点Aから線分BCへの垂線の足H、垂線AH　→垂心　→点と直線との距離
OPTION ARITHMETIC COMPLEX
LET a=ABS(OC-OB) !線分BCの長さ
LET b=ABS(OA-OC) !線分CA
LET c=ABS(OB-OA) !線分AB

LET BH=(c^2+a^2-b^2)/(2*a) !BH=AB*cosBと余弦定理b^2=c^2+a^2-2*c*a*cosB
LET BC=a
LET OH=OB+(BH/BC)*(OC-OB) !垂線の足の位置ベクトル　↑OH=↑OB+↑BH=↑OB+t*↑BCより

CALL gcDOT(OA,"") !点Aを描く
CALL gcLINE(OB,OC,"") !線分BCを描く
CALL gcLINE(OA,OH,"") !垂線AHを描く
IF N$="" THEN LET t$="H" ELSE LET t$=N$
CALL gcDOT(OH,t$) !点Hを描く
END SUB


EXTERNAL SUB gcTANGENTLINE(OA,OC,R,N$, OP,OQ,K) !点Aから円に接線を引く
OPTION ARITHMETIC COMPLEX
LET Rd=ABS(OC-OA) !線分ACを直径とする円
LET OD=(OA+OC)/2 !中心
IF Rd=R THEN !点Aが円周上の点
   LET OP=OA
   CALL gcDOT(OP,N$(1:1)) !点Pを描く
   LET K=1
ELSEIF Rd>R THEN
   CALL gcINTERSECTION2C(OD,Rd/2,OC,R,"", OP,OQ,K) !元の円との交点が接点となる
   CALL gcCIRCLE(OC,R,"") !元の円を描く
   CALL gcLINE(OA,OP,N$(1:2)) !線分APを描く
   CALL gcLINE(OQ,OA,N$(3:3)) !点Qを描く
   LET K=2
ELSE
   PRINT "接線はありません。"
   STOP
END IF
END SUB


EXTERNAL SUB gcTANGENTLINE1C(OA,OC,N$, AP) !円周上の点における接線
OPTION ARITHMETIC COMPLEX
LET nCA=fnNormalize(OA-OC)
LET t=5 !t=[0,∞]　※範囲は調整が必要である
LET OP=OA+v(-Im(nCA),Re(nCA))*t
LET AP=OP-OA
CALL gcFLINE(OA,AP,N$)
END SUB


EXTERNAL SUB gcTANGENTLINE2C(OA,Ra,OB,Rb,N$, OP(),K) !２円の共通接線
OPTION ARITHMETIC COMPLEX
LET AB=OB-OA
LET l=ABS(AB)
LET a0=fnANGLE(v(1,0),AB) !↑ABの角度

LET t=Ra-Rb
IF ABS(t)<l THEN !接線あり
   LET a1=ACOS(t/l) !接点の角度

   LET OP(1)=OA+fnROTATE(Ra,a0+a1) !円１の接点
   LET OP(2)=OA+fnROTATE(Ra,a0-a1)

   LET OP(3)=OB+fnROTATE(Rb,a0+a1) !円２の接点
   LET OP(4)=OB+fnROTATE(Rb,a0-a1)
   LET K=4


   LET tt=Ra+Rb
   IF tt<l THEN !外側で交わらない
      LET a2=ACOS(tt/l) !接点の角度
      LET OP(5)=OA+fnROTATE(Ra,a0+a2) !円１の接点
      LET OP(6)=OA+fnROTATE(Ra,a0-a2)

      LET OP(7)=OB+fnROTATE(Rb,a0+a2+PI) !円２の接点
      LET OP(8)=OB+fnROTATE(Rb,a0-a2+PI)
      LET K=8
   ELSEIF tt=l THEN !接している
      LET OP(5)=OA+v(Ra*COS(a0),Ra*SIN(a0)) !接点
      LET K=5
      CALL gcDOT(OP(5),N$(5:5))
   ELSE
   END IF

   IF K>=4 THEN
      CALL gcLINE(OP(1),OP(3),N$(1:1)&N$(3:3)) !共通外接線　※番号に注意すること
      CALL gcLINE(OP(2),OP(4),N$(2:2)&N$(4:4))
      IF K=8 THEN
         CALL gcLINE(OP(5),OP(7),N$(5:5)&N$(7:7)) !共通内接線
         CALL gcLINE(OP(6),OP(8),N$(6:6)&N$(8:8))
      END IF
   END IF

ELSEIF ABS(t)=l THEN !内側で接している
   LET OP(1)=OA+fnROTATE(Ra,a0+PI) !接点
   LET K=1
   CALL gcDOT(OP(1),N$(1:1))

ELSE !内側で交わらない
   PRINT "接線はありません。"
   STOP
END IF

CALL gcCIRCLE(OA,Ra,"") !円１
CALL gcCIRCLE(OB,Rb,"") !円２
END SUB


!●半直線

EXTERNAL SUB gcHLINE(OP,AB,N$) !点Pを通る、ベクトルABに平行な半直線
OPTION ARITHMETIC COMPLEX
LET t=5 !t=[0,∞]　※範囲は調整が必要である
LET OQ=OP+AB*t
CALL gcLINE(OP,OQ,N$) !線分PQを描く
END SUB


EXTERNAL SUB gcA2LINE(OA,OB,OC, AP) !∠BACを二等分する線　→内心、内接円　→傍心、傍接円
OPTION ARITHMETIC COMPLEX
LET t=5 !t=[0,∞]　※範囲は調整が必要である
LET AB=OB-OA
LET AC=OC-OA
LET OP=OA+(fnNormalize(AB)+fnNormalize(AC))*t !ひし形AbDcの対角線AD

LET AP=fnNormalize(OP-OA) !方向ベクトル

CALL gcLINE(OA,OP,"") !線分APを描く
END SUB



つづく 		 

Re: 作図ツール（Geometric Constructor）

 投稿者：山中和義  投稿日：2010年12月19日(日)15時16分18秒
  > No.1472[元記事へ]

つづき


!●円

EXTERNAL SUB gcCIRCLE(Oo,R,N$) !中心点と半径（中心点と円周上の点、中心と直径にも応用できる）　|z-α|=r
OPTION ARITHMETIC COMPLEX
SET LINE COLOR gcCOLOR
FOR i=0 TO 360 !弧は折れ線で近似する
   LET x=R*COS(RAD(i))
   LET y=R*SIN(RAD(i))
   PLOT LINES: x+Re(Oo),y+Im(Oo);
NEXT i
PLOT LINES
CALL gcDOT(Oo,N$) !中心を描く
END SUB


EXTERNAL SUB gcCIRCLE2(OA,OB,R,N$, OC) !円周上の２点と半径
OPTION ARITHMETIC COMPLEX
LET OT=(OA+OB)/2 !弦ABの中点
LET AT=OT-OA
LET t=R^2-fnDOT(AT,AT) !三角形ACTの辺CTの長さ
IF t>=0 THEN
   LET AB=OB-OA
   LET OC=OT+fnNormalize( v(-Im(AB),Re(AB)) )*SQR(t) !垂直二等分線上　※↑ABの左側
   CALL gcCIRCLE(OC,R,"")
   CALL gcLINE(OA,OC,N$(1:1)) !点A、半径を描く
   CALL gcDOT(OB,N$(2:2)) !点Bを描く
ELSE
   PRINT "作図できません。"
   STOP
END IF
END SUB


!●三角形

EXTERNAL SUB gcTRIANGLE(OA,OB,OC,N$, a,b,c,S) !頂点A,B,Cの三角形で、３辺の長さa,b,cと面積Sを返す
OPTION ARITHMETIC COMPLEX
LET a=ABS(OC-OB) !辺BCの長さ
LET b=ABS(OA-OC) !辺CA
LET c=ABS(OB-OA) !辺AB

LET S=gcHERON(a,b,c) !三角形ABCの面積

CALL gcLINE(OA,OB,N$(1:1)) !頂点、辺を描く
CALL gcLINE(OB,OC,N$(2:2))
CALL gcLINE(OC,OA,N$(3:3))
END SUB


EXTERNAL FUNCTION gcHERON(a,b,c) !３辺a,b,cの三角形の面積S
OPTION ARITHMETIC COMPLEX
LET t=(a+b+c)/2 !ヘロンの公式より、面積S
LET gcHERON=SQR(t*(t-a)*(t-b)*(t-c))
END FUNCTION


!●三角形の心

EXTERNAL SUB gcINCENTER(OA,OB,OC,N$, OI,R) !三角形ABCの内心（三角形ABCに内接する円の中心と半径）
OPTION ARITHMETIC COMPLEX
CALL gcTRIANGLE(OA,OB,OC,"", a,b,c,S)

LET OI=(a*OA+b*OB+c*OC)/(a+b+c) !内心の位置ベクトル
LET R=2*S/(a+b+c) !S=△IAB+△IBC+△ICA=1/2*c*r+1/2*a*r+1/2*b*r=r*(a+b+c)/2より

IF N$="" THEN LET t$="I" ELSE LET t$=N$
CALL gcCIRCLE(OI,R,t$) !内接円を描く
END SUB


EXTERNAL SUB gcCIRCUMCENTER(OA,OB,OC,N$, Oo,R) !三角形ABCの外心（三角形ABCに外接する円の中心と半径）
OPTION ARITHMETIC COMPLEX
CALL gcTRIANGLE(OA,OB,OC,"", a,b,c,S)

LET sin2A=2*S*(b^2+c^2-a^2)/(b*c)^2 !sin2A=2*cosA*sinA、余弦定理cosA=(b^2+c^2-a^2)/(2*b*c)、面積S=1/2*b*c*sinAより
LET sin2B=2*S*(c^2+a^2-b^2)/(c*a)^2
LET sin2C=2*S*(a^2+b^2-c^2)/(a*b)^2

LET Oo=(sin2A*OA+sin2B*OB+sin2C*OC)/(sin2A+sin2B+sin2C) !外心の位置ベクトル
LET R=a*b*c/(4*S) !正弦定理a/sinA=b/sinB=c/sinC=2*Rと面積S=1/2*b*c*sinAより

IF N$="" THEN LET t$="o" ELSE LET t$=N$
CALL gcCIRCLE(Oo,R,t$) !外接円を描く
END SUB


EXTERNAL SUB gcGRAVITY(OA,OB,OC,N$, OG) !三角形ABCの重心
OPTION ARITHMETIC COMPLEX
LET OG=(OA+OB+OC)/3 !重心の位置ベクトル

IF N$="" THEN LET t$="G" ELSE LET t$=N$
CALL gcDOT(OG,t$) !重心を描く
END SUB


EXTERNAL SUB gcORTHOCENTER(OA,OB,OC,N$, OH) !三角形ABCの垂心
OPTION ARITHMETIC COMPLEX
CALL gcTRIANGLE(OA,OB,OC,"", a,b,c,S)

LET tanA=2*S/(b^2+c^2-a^2) !tanA=sinA/cosAと余弦定理cosA=(b^2+c^2-a^2)/(2*b*c)と面積S=1/2*b*c*sinAより
LET tanB=2*S/(c^2+a^2-b^2)
LET tanC=2*S/(a^2+b^2-c^2)
LET OH=(tanA*OA+tanB*OB+tanC*OC)/(tanA+tanB+tanC) !垂心の位置ベクトル

IF N$="" THEN LET t$="H" ELSE LET t$=N$
CALL gcDOT(OH,t$) !垂心を描く
END SUB


EXTERNAL SUB gcEXCENTER(OA,OB,OC,N$, OI,R) !三角形ABCの傍心（点Aを頂角、点B,Cを外角とする）
OPTION ARITHMETIC COMPLEX
CALL gcTRIANGLE(OA,OB,OC,"", a,b,c,S)

LET OI=((-a)*OA+b*OB+c*OC)/((-a)+b+c) !傍心の位置ベクトル
LET R=2*S/((-a)+b+c) !S=(s-a)*Ra、s=(a+b+c)/2より

IF N$="" THEN LET t$="Ia" ELSE LET t$=N$
CALL gcCIRCLE(OI,R,t$) !傍接円を描く
END SUB


!●多角形

EXTERNAL SUB gcPOLYGON(OC,OA,N,N$, OP()) !点Cを中心、点Aを１頂点とする正ｎ角形
OPTION ARITHMETIC COMPLEX
LET CA=OA-OC
LET R=ABS(CA) !線分CAの長さ
LET a=fnANGLE(v(1,0),CA) !↑CAの角度

LET OP(1)=OA !１点目
FOR i=2 TO N !点Cを中心、半径Rの円
   LET th=a+2*PI*(i-1)/N !円周の分割点を結ぶ
   LET OT=OC+v(R*COS(th),R*SIN(th))
   CALL gcLINE(OP(i-1),OT,N$(i-1:i))
   LET OP(i)=OT
NEXT i
CALL gcLINE(OP(N),OA,"") !閉じる
CALL gcLINE(OA,OC,"")
END SUB


EXTERNAL SUB gcPOLYGON2(OA,OB,N,N$, OP(),OC,R) !線分ABを一辺とする正ｎ角形　※↑ABの左側
OPTION ARITHMETIC COMPLEX
LET m=ABS(OB-OA) !一辺の長さ
LET R=m/(2*SIN(PI/N)) !半径
CALL gcCIRCLE2(OA,OB,R,"", OC) !２点半径円から外接円を求める
CALL gcPOLYGON(OC,OA,N,N$, OP)
END SUB


↑↑↑↑↑ ここまでがサブルーチン ↑↑↑↑↑



サンプル１


　：
　：　先頭部分は記載を省略する

!------------------------------ ここまでがサブルーチン


!●頂角を持たない角の２等分線を引く

LET OA=v(-5,1) !線分AB
LET OB=v(3,6)
CALL gcLINE(OA,OB,"AB")

LET OC=v(-2,-4) !線分CD
LET OD=v(5,-3)
CALL gcLINE(OC,OD,"CD")


LET gcCOLOR=2
LET OX=v(-1,7) !交差するように任意の線分を引く
LET OY=v(2,-6)
CALL gcLINE(OX,OY,"")

CALL gcINTERSECTION(OA,OB,OX,OY,"P", OP) !交点Pとする
CALL gcINTERSECTION(OC,OD,OX,OY,"Q", OQ) !交点Qとする


LET gcCOLOR=3
CALL gcA2LINE(OP,OA,OQ, Pp) !内角（∠APQ、∠PQC）の２等分線を引く
CALL gcA2LINE(OQ,OP,OC, Qq)
CALL gcINTERSECTION(OP,OP+Pp*1,OQ,OQ+Qq*1,"S", OS) !交点Sとする

CALL gcA2LINE(OP,OQ,OB, Pp) !外角（∠QPB、∠DQP）の２等分線を引く
CALL gcA2LINE(OQ,OD,OP, Qq)
CALL gcINTERSECTION(OP,OP+Pp*1,OQ,OQ+Qq*1,"T", OT) !交点Tとする


LET gcCOLOR=4
CALL gcFLINE(OS,OT-OS,"") !直線STが求める「２等分線」となる


END

　：
　：　以下サプルーチンは、記載を省略する



サンプル２


　：
　：　先頭部分は記載を省略する

!------------------------------ ここまでがサブルーチン


!●傍心

LET OA=v(1,3) !三角形ABCの頂点
LET OB=v(-2,-2)
LET OC=v(3,-1)

LET gcCOLOR=1
CALL gcEXCENTER(OA,OB,OC,"", OI,R) !傍心

CALL gcFLINE(OB,OB-OA,"B") !線分ABを延ばす
CALL gcFLINE(OC,OC-OB,"C") !線分BCを延ばす
CALL gcFLINE(OA,OA-OC,"A") !線分CAを延ばす

LET gcCOLOR=4
CALL gcCIRCLE(OI,R,"") !傍接円を描く

CALL gcINTERSECTION1C(OB,OC,OI,R,"1",OP,OQ,K) !接点
CALL gcINTERSECTION1C(OA,OB,OI,R,"2",OP,OQ,K)
CALL gcINTERSECTION1C(OA,OC,OI,R,"3",OP,OQ,K)


LET gcCOLOR=3
CALL gcEXCENTER(OB,OC,OA,"Ib", OI,R) !傍心
CALL gcCIRCLE(OI,R,"") !傍接円を描く


LET gcCOLOR=2
CALL gcEXCENTER(OC,OA,OB,"Ic", OI,R) !傍心
CALL gcCIRCLE(OI,R,"") !傍接円を描く


END

　：
　：　以下サプルーチンは、記載を省略する
 

Re: 作図ツール（Geometric Constructor）

 投稿者：山中和義  投稿日：2010年12月23日(木)09時20分36秒
  軌跡

サンプル　線上を動くとき


　：　先頭部分は省略
　：
!------------------------------ ここまでがサブルーチン


!線分AB上に点Cを取り、線分AC,CBを１辺とする正三角形△ACD,△CBEを作る。
!直線AE,BDの交点をPとする。
!点Cが線分AB上を動くとき、点Pはどのような軌跡を描くか。

LET gcFRAME=20 !フレーム数（コマ数）
DIM gcOP(0 TO gcFRAME) !動点


LET OA=v(-2,-3) !点A
LET OB=v(4,0) !点B

LET AB=OB-OA !点Cが線分AB上を動く
FOR t=0 TO gcFRAME
   CLEAR
   DRAW grid

   LET gcCOLOR=12 !移動する線分
   LET gcSTYLE=2
   CALL gcLINE(OA,OB,"")
   !!!CALL gcFLINE(OA,OB-OA,"")

   LET OC=OA+AB*(t/gcFRAME) !線分AB上 OC=OA+AB*t、t=[0,1]より
   !!!LET OC=OA+AB*(5*(t/gcFRAME-0.5)) !直線AB上 OC=OA+AB*t、t=[-∞,∞]より

   CALL frame(t) !題意に従い作図する
   FOR i=0 TO t !点Pの軌跡
      PLOT LINES: Re(gcOP(i)),Im(gcOP(i));
   NEXT i
   PLOT LINES

   WAIT DELAY 0.25 !4fpsアニメーション
NEXT t


SUB frame(t) !作図
   DIM OX(3)

   LET gcCOLOR=1
   LET gcSTYLE=4
   CALL gcPOLYGON2(OA,OC,3,"ACD", OX,Oo,R) !一辺ACの正三角形ACD
   LET OD=OX(3)
   CALL gcPOLYGON2(OC,OB,3,"CBE", OX,Oo,R) !一辺CBの正三角形CBE
   LET OE=OX(3)

   LET gcCOLOR=2
   CALL gcFLINE(OA,OE-OA,"") !直線AE
   CALL gcFLINE(OB,OD-OB,"") !直線BD

   LET gcCOLOR=4
   LET gcSTYLE=1
   CALL gcINTERSECTION(OA,OE,OB,OD,"P", OP) !交点P

   LET gcOP(t)=OP !点Pの軌跡
END SUB

END

　：　以下、サブルーチンは省略
　：



サンプル　円周上を動くとき


　：　先頭部分は省略
　：
!------------------------------ ここまでがサブルーチン

!点A,B,Cを取り、線分AC,CBを１辺とする正三角形△ACD,△CBEを作る。
!直線AE,BDの交点をPとする。
!点Cが円周上を動くとき、点Pはどのような軌跡を描くか。

LET gcFRAME=360 !フレーム数（コマ数）
DIM gcOP(0 TO gcFRAME) !動点


LET OA=v(-4,-1) !点A
LET OB=v(5,5) !点B

LET Oq=v(1,-3) !点Cが円周上を動く
LET Rq=3
FOR t=0 TO gcFRAME
   CLEAR
   DRAW grid

   LET gcCOLOR=12 !移動する円周上
   LET gcSTYLE=2
   CALL gcCIRCLE(Oq,Rq,"")

   LET OC=Oq+fnROTATE(Rq,2*PI*t/gcFRAME)

   CALL frame(t) !題意に従い作図する
   FOR i=0 TO t !点Pの軌跡
      PLOT LINES: Re(gcOP(i)),Im(gcOP(i));
   NEXT i
   PLOT LINES

   WAIT DELAY 0.1 !10fpsアニメーション
NEXT t


SUB frame(t) !作図
   DIM OX(3)

   LET gcCOLOR=1
   LET gcSTYLE=4
   CALL gcPOLYGON2(OA,OC,3,"ACD", OX,Oo,R) !一辺ACの正三角形ACD
   LET OD=OX(3)
   CALL gcPOLYGON2(OC,OB,3,"CBE", OX,Oo,R) !一辺CBの正三角形CBE
   LET OE=OX(3)

   LET gcCOLOR=2
   CALL gcFLINE(OA,OE-OA,"") !直線AE
   CALL gcFLINE(OB,OD-OB,"") !直線BD

   LET gcCOLOR=4
   LET gcSTYLE=1
   CALL gcINTERSECTION(OA,OE,OB,OD,"P", OP) !交点P

   LET gcOP(t)=OP !点Pの軌跡
END SUB

END

　：　以下、サブルーチンは省略
　：
 

戻る