| |
ponponです。こんにちは。
三角形の頂点を平行移動して等積変形をビジュアルに行おうと考えています。
過去ログを調べたのですが、三角形の頂点の座標を取得する方法がわからなかったので、lineで作っていきました。
しかし、変形最後のラインを取得して実線化、グループ化してforecolorで塗りつぶしを行おうとしましたができません。
質問１ 三角形の頂点の取得ができるのなら、教えてください。
質問２ line（今やっている方法）で最後とその一つ前に描画したlineのnameの 取得の仕方を教えてください。
質問３ 本当は２本消して２本描画２本消して２本描画というように、頂点が移 動しているように見せたいのですが、できますか？
以下今まで作成したコードです。
Sub 三角形の描画()
With Sheets("sheet1").Shapes
.AddLine 200, 200, 400, 200
.AddLine 200, 200, 340, 100
.AddLine 340, 100, 400, 200
DoEvents
Application.Wait (Now + TimeValue("0:00:01"))
.AddLine(50, 200, 600, 200).Line.DashStyle = msoLineDashDot
.AddLine(50, 100, 600, 100).Line.DashStyle = msoLineDashDot
End With
End Sub
Sub 頂点の移動()
With Sheets("sheet1").Shapes
For i = 5 To 250 Step 10
With .AddLine(200, 200, 340 + i, 100).Line
.DashStyle = msoLineDash
.ForeColor.RGB = RGB(255 - i, 100, 100)
End With
With .AddLine(340 + i, 100, 400, 200).Line
.DashStyle = msoLineDash
.ForeColor.RGB = RGB(255 - i, 100, 100)
End With
Application.Wait (Now + TimeValue("0:00:01"))
Next
' A = Sheets("sheet1").Shapes.Count
' Sheets("sheet1").Shapes.Range(Array(A - 1, A)).DashStyle = msoLineSolid
'↑シェイプの数を取得して最後とその一つ前を実線にしようとしましたが、
'うまくいきませんでした。
End With
End Sub
Sub 図の削除()
ActiveSheet.Lines.Delete
End Sub
|
|
ponpon
- 05/2/11(金) 12:46 -
