AFsoft World

// テストプログラム：リフト（修正）
//
// =============================================
// (C)Copyright 2010 AFsoft All Rights Reserved.
// =============================================
#LIST
　ko = "左","中","右"
#VAR
　d1x = 1000　　　;*土台X
　d1y =　100　　　;*土台Y
　d2x = 1000　　　;*リフト台X
　d2y =　100　　　;*リフト台Y
　ko =　左　　　　;*リンク固定点
　l = 1200　　　　;*リンク長さ
　w =　100　　　　;*リンク太さ
　l1x = 50　　　　;*リンク土台端からのX(左/右の際に有効)
　l1y = 50　　　　;*リンク土台底辺からの高さ
　l2y = 50　　　　;*リンクリフト台底辺からの高さ
　h = 1000　　　　;*高さ

　ang
　iko
　kx
　ky
　x1
　y1
　x2
　y2
　cx1
　cy1
　cx2
　cy2
　w1
　w2
　wx1
　wy1
　wx2
　wy2
　wx3
　wy3
　wx4
　wy4
　
#DRAW
　// エラーチェック（最低限）
　// CAL　x1 = (d1y - l1y) + l2y　　// 土台の上にリフト台が乗る場合
　CAL　x1 = 0
　CAL　x2 = l
　#IF ( (h < x1) || (h > x2) )
　　BEEP
　　MESSAGE "入力エラー","高さの入力エラーです","値を再入力して下さい。",x1,x2
　　#EXIT
　#END
　CAL　x1 = Sqrt(l*l - h*h)
　CAL　x2 = d1x - l1x
　#IF (x1 > x2)
　　BEEP
　　MESSAGE "入力エラー","リンクが土台からはみ出てしまいます","値を再入力して下さい。",0,0
　　#EXIT
　#END
　CAL　x2 = d2x - l1x
　#IF (x1 > x2)
　　BEEP
　　MESSAGE "入力エラー","リンクがリフト台からはみ出てしまいます","値を再入力して下さい。",0,0
　　#EXIT
　#END

　GETANGLE　ang,x1,h
　CHKITEM iko,ko,ko
　CAL　ky = l1y + h - l2y　　// リフト台基準点
　CAL　kx = 0
　#IF (iko == 0)
　　CAL　kx =-d1x/2+Abs(l1x)
　#END
　#IF (iko == 2)
　　CAL　kx = d1x/2-Abs(l1x)
　　CAL　ang = PI - ang
　#END

　LAYER　SetLineLay4　　// 基準線
　PEN SetLineCol4,SetLineLtp4,SetLineWid4
　// 基準線
　CAL　x1 =-d1x/2 - SetZ1　　// 中心線はみ出し距離考慮
　CAL　y1 = l1y
　CAL　x2 = d1x/2 + SetZ1
　CAL　y2 = l1y
　LINE　x1,y1,x2,y2

　CAL　x1 =-d2x/2 - SetZ1
　CAL　y1 = ky + l2y
　CAL　x2 = d2x/2 + SetZ1
　CAL　y2 = ky + l2y
　LINE　x1,y1,x2,y2

　CAL　x1 = 0
　CAL　y1 = ky + d2y + SetZ1
　CAL　x2 = 0
　CAL　y2 =-SetZ1
　LINE　x1,y1,x2,y2

　LAYER　SetLineLay1　　// 外径線
　PEN SetLineCol1,SetLineLtp1,SetLineWid1
　// 土台
　CAL　x1 =-d1x / 2
　CAL　y1 = 0
　CAL　x2 = d1x / 2
　CAL　y2 = d1y
　BOX　x1,y1,x2,y2
　// リフト台
　CAL　x1 =-d2x / 2
　CAL　y1 = ky
　CAL　x2 = d2x / 2
　CAL　y2 = ky + d2y
　BOX　x1,y1,x2,y2

　// ----- リンク -----

　#IF (iko == 0)
　　CAL　cx1 = kx
　　CAL　cy1 = l1y
　　CAL　cx2 = cx1 + Sqrt(l*l - h*h)
　　CAL　cy2 = l1y + h
　#END
　#IF (iko == 1)
　　CAL　cx1 =-Sqrt(l*l - h*h) / 2
　　CAL　cy1 = l1y
　　CAL　cx2 = Sqrt(l*l - h*h) / 2
　　CAL　cy2 = l1y + h
　#END
　#IF (iko == 2)
　　CAL　cx1 = kx
　　CAL　cy1 = l1y
　　CAL　cx2 = cx1 - Sqrt(l*l - h*h)
　　CAL　cy2 = l1y + h
　#END

　LAYER　SetLineLay3　　// 中心線
　PEN SetLineCol3,SetLineLtp3,SetLineWid3
　// 中心線
　LINE　cx1,cy1,cx2,cy2
　LINE　cx1,cy2,cx2,cy1

　LAYER　SetLineLay1　　// 外径線
　PEN SetLineCol1,SetLineLtp1,SetLineWid1
　CAL　wx1 = cx1 + w/2*Cos(ang+0.5*PI)
　CAL　wy1 = cy1 + w/2*Sin(ang+0.5*PI)
　CAL　wx2 = cx2 + w/2*Cos(ang+0.5*PI)
　CAL　wy2 = cy2 + w/2*Sin(ang+0.5*PI)
　CAL　wx3 =-d1x/2
　CAL　wy3 = d1y
　CAL　wx4 = d1x/2
　CAL　wy4 = d1y
　GETCRSLL　w1,x1,y1,wx1,wy1,wx2,wy2,wx3,wy3,wx4,wy4
　CAL　wx3 =-d2x/2
　CAL　wy3 = ky
　CAL　wx4 = d2x/2
　CAL　wy4 = ky
　GETCRSLL　w2,x2,y2,wx1,wy1,wx2,wy2,wx3,wy3,wx4,wy4
　#IF ( (w1 == 1) && (w2 == 1) )
　　LINE　x1,y1,x2,y2
　#END
　
　CAL　wx1 = cx1 + w/2*Cos(ang-0.5*PI)
　CAL　wy1 = cy1 + w/2*Sin(ang-0.5*PI)
　CAL　wx2 = cx2 + w/2*Cos(ang-0.5*PI)
　CAL　wy2 = cy2 + w/2*Sin(ang-0.5*PI)
　CAL　wx3 =-d1x/2
　CAL　wy3 = d1y
　CAL　wx4 = d1x/2
　CAL　wy4 = d1y
　GETCRSLL　w1,x1,y1,wx1,wy1,wx2,wy2,wx3,wy3,wx4,wy4
　CAL　wx3 =-d2x/2
　CAL　wy3 = ky
　CAL　wx4 = d2x/2
　CAL　wy4 = ky
　GETCRSLL　w2,x2,y2,wx1,wy1,wx2,wy2,wx3,wy3,wx4,wy4
　#IF ( (w1 == 1) && (w2 == 1) )
　　LINE　x1,y1,x2,y2
　#END
　
　CAL　wx1 = cx1 + w/2*Cos(PI-ang+0.5*PI)
　CAL　wy1 = cy2 + w/2*Sin(PI-ang+0.5*PI)
　CAL　wx2 = cx2 + w/2*Cos(PI-ang+0.5*PI)
　CAL　wy2 = cy1 + w/2*Sin(PI-ang+0.5*PI)
　CAL　wx3 =-d1x/2
　CAL　wy3 = d1y
　CAL　wx4 = d1x/2
　CAL　wy4 = d1y
　GETCRSLL　w1,x1,y1,wx1,wy1,wx2,wy2,wx3,wy3,wx4,wy4
　CAL　wx3 =-d2x/2
　CAL　wy3 = ky
　CAL　wx4 = d2x/2
　CAL　wy4 = ky
　GETCRSLL　w2,x2,y2,wx1,wy1,wx2,wy2,wx3,wy3,wx4,wy4
　#IF ( (w1 == 1) && (w2 == 1) )
　　LINE　x1,y1,x2,y2
　#END
　
　CAL　wx1 = cx1 + w/2*Cos(PI-ang-0.5*PI)
　CAL　wy1 = cy2 + w/2*Sin(PI-ang-0.5*PI)
　CAL　wx2 = cx2 + w/2*Cos(PI-ang-0.5*PI)
　CAL　wy2 = cy1 + w/2*Sin(PI-ang-0.5*PI)
　CAL　wx3 =-d1x/2
　CAL　wy3 = d1y
　CAL　wx4 = d1x/2
　CAL　wy4 = d1y
　GETCRSLL　w1,x1,y1,wx1,wy1,wx2,wy2,wx3,wy3,wx4,wy4
　CAL　wx3 =-d2x/2
　CAL　wy3 = ky
　CAL　wx4 = d2x/2
　CAL　wy4 = ky
　GETCRSLL　w2,x2,y2,wx1,wy1,wx2,wy2,wx3,wy3,wx4,wy4
　#IF ( (w1 == 1) && (w2 == 1) )
　　LINE　x1,y1,x2,y2
　#END