Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

68822 / 76734

←次へ　｜　前へ→


	【12438】Re:ひし形

ichinose - 04/4/4(日) 0:22 -


	引用なし

	パスワード

こんばんは。
再挑戦です。

>要は、平行四辺形を作成した後、円の奇跡で４角の内の２点を移動させると言う事です。
軌跡でした（実は、これ訂正するためにコード作ったりして・・）。

以下のコードで
>右斜め45度の線と真横の線
の平行四辺形が作成できると思います。

'=================================================================
Const stx = 150
Const sty = 100
Const edx = 300
Const edy = 220
'=================================================================
Sub Mk_Parallelogram2()
　 Dim p_x(1 To 4) As Double　'平行四辺形の4角のｘ
　 Dim p_y(1 To 4) As Double　'平行四辺形の4角のY
　 Dim para As Shape '平行四辺形のShapeオブジェクト
　 Dim rs As Double
　 Dim pai As Double　'円周率
　 If stx < edx And sty < edy Then
　　　If stx - (edy - sty) >= 0 Then
　　　Else
　　　　 MsgBox "回転できませんから、処理中止"
　　　　 Exit Sub
　　　　 End If
　　　End If
　 pai = WorksheetFunction.pi()
　 p_x(1) = stx: p_y(1) = sty
　 p_x(2) = edx: p_y(2) = sty
　 p_x(3) = edx: p_y(3) = edy
　 p_x(4) = stx: p_y(4) = edy
　 rs = edy - sty
　 With ActiveSheet.Shapes.BuildFreeform(msoEditingAuto, p_x(1), p_y(1))
　　　For idx = 2 To 4
　　　　 .AddNodes msoSegmentLine, msoEditingAuto, p_x(idx), p_y(idx)
　　　　 Next idx
　　　.AddNodes msoSegmentLine, msoEditingAuto, p_x(1), p_y(1)
　　　Set para = .ConvertToShape
　　　End With
　 DoEvents
　 MsgBox "この四角形の上二つの頂点を右４５°に傾けます"
　 With para
　　　 rr = -pai / 4
　　　 .Nodes.SetPosition 1, p_x(4) + rs * Cos(rr), p_y(4) + rs * Sin(rr)
　　　 .Nodes.SetPosition 2, p_x(3) + rs * Cos(rr), p_y(3) + rs * Sin(rr)
　　　 p_x(1) = p_x(4) + rs * Cos(rr): p_y(1) = p_y(4) + rs * Sin(rr)
　　　 p_x(2) = p_x(3) + rs * Cos(rr): p_y(2) = p_y(3) + rs * Sin(rr)
　　　 DoEvents
　　　 MsgBox "平行四辺形が作れた？ここから、右回り１回転します"
　　　 For rr = -pai / 4 To -pai / 4 + pai * 2 Step 0.001
　　　　 .Nodes.SetPosition 1, p_x(4) + rs * Cos(rr), p_y(4) + rs * Sin(rr)
　　　　 .Nodes.SetPosition 2, p_x(3) + rs * Cos(rr), p_y(3) + rs * Sin(rr)
　　　　 Next
　　　 MsgBox "今度は、軸を変えて右回り１回転します"
　　　 For rr = pai * 3 / 4 To pai * 3 / 4 + pai * 2 Step 0.001
　　　　 .Nodes.SetPosition 3, p_x(2) + rs * Cos(rr), p_y(2) + rs * Sin(rr)
　　　　 .Nodes.SetPosition 4, p_x(1) + rs * Cos(rr), p_y(1) + rs * Sin(rr)
　　　　 Next
　　　 End With
End Sub

Constの値を「stx<edx　且つ sty<edy」の条件下で設定してみて下さい。
前回と同じ様に2角を回転させましたが、

>右斜め45度の線と真横の線を上下に変えれたらと考えています。

の意味が他の意味合いだったら又考えます（平行移動だったらIncrementTopや
IncrementLeftでもいいかも・・）。

確認してみて下さい。

1 hits

▼

【12403】ひし形 nyan 04/4/2(金) 15:24