- 01: 名前：こしら投稿日：2005/08/26(金) 21:19
- グループになった図形を回転させて、正味の幅と高さを
取得しようとしています。
WinObj.Selection.BoundingBox visBBoxExtents , DDLeft, DDBottom, DDRight, DDTop
などとして回転後に図形を囲む四角の座標を取得しますが、
図形そのものに接するサイズを返してくれません。
このメソッド以外に回転後の図形に接する四角のサイズを取得する
方法はないものでしょうか。
よろしくお願い致します。
- 05: 名前：yoda投稿日：2005/08/27(土) 16:56
- ひねってやってみましたが、グループの中の子シェイプのBoundingBox
は、グループが回転する前の物しかできない。
ということは、いったんグループを解除して、個々の子シェイプについて、
BoundingBoxを求め、その後グループを修復するしかなさそうです。
- 06: 名前：yoda投稿日：2005/08/27(土) 21:22
- こんな風になりますが、なんか、もっと楽な方法があるような気がします。
Dim shp As Visio.Shape
Dim child As Visio.Shape
Dim dblTop As Double
Dim dblBottom As Double
Dim dblLeft As Double
Dim dblRight As Double
Dim rect As Visio.Shape
Dim dblPinX As Double, dblPinY As Double
Dim dblChildPinX As Double, dblChildPinY As Double
Dim dblWidth As Double, dblHeight As Double
Dim dblAngle As Double
Dim myShapes As Collection
Dim mySelection As Visio.Selection
Set myShapes = New Collection
Set shp = ActivePage.Shapes(1)
dblPinX = shp.Cells("PinX")
dblPinY = shp.Cells("PinY")
dblAngle = shp.Cells("Angle").Result(visRadians)
For Each child In shp.Shapes
myShapes.Add child
Next
shp.Ungroup
For Each child In myShapes
child.BoundingBox visTypeShape + visBBoxUprightWH, _
dblLeft, dblBottom, dblRight, dblTop
dblChildPinX = child.Cells("PinX")
dblChildPinY = child.Cells("PinY")
dblWidth = dblRight - dblLeft
dblHeight = dblTop - dblBottom
Set rect = ActivePage.DrawRectangle( _
dblChildPinX - dblWidth * 0.5, dblChildPinY - dblHeight * 0.5 _
, dblChildPinX + dblWidth * 0.5, dblChildPinY + dblHeight * 0.5)
ActiveWindow.Select rect, visSelect
ActiveWindow.Selection.SendToBack
Next
Set mySelection = ActiveWindow.Selection
mySelection.DeselectAll
For Each child In myShapes
mySelection.Select child, visSelect
Next
mySelection.Rotate dblAngle * -1#, visRadians, , visRotateSelectionWithPin, dblPinX, dblPinY
Set shp = mySelection.Group
shp.Cells("Angle").Result(visRadians) = dblAngle
- 07: 名前：yoda投稿日：2005/08/27(土) 22:09
- 最終的には、これら囲んだ四角形全体のBoundingBoxを作れば、よさそう。
- 08: 名前：yoda投稿日：2005/08/27(土) 22:12
- それを追加すると、このようになりますが、、、、
Dim shp As Visio.Shape
Dim child As Visio.Shape
Dim dblTop As Double
Dim dblBottom As Double
Dim dblLeft As Double
Dim dblRight As Double
Dim rect As Visio.Shape
Dim dblPinX As Double, dblPinY As Double
Dim dblChildPinX As Double, dblChildPinY As Double
Dim dblWidth As Double, dblHeight As Double
Dim dblAngle As Double
Dim myShapes As Collection
Dim mySelection As Visio.Selection
Dim myRects As Collection
Set myShapes = New Collection
Set myRects = New Collection
Set shp = ActivePage.Shapes(1)
dblPinX = shp.Cells("PinX")
dblPinY = shp.Cells("PinY")
dblAngle = shp.Cells("Angle").Result(visRadians)
For Each child In shp.Shapes
myShapes.Add child
Next
shp.Ungroup
For Each child In myShapes
child.BoundingBox visTypeShape + visBBoxUprightWH, _
dblLeft, dblBottom, dblRight, dblTop
dblChildPinX = child.Cells("PinX")
dblChildPinY = child.Cells("PinY")
dblWidth = dblRight - dblLeft
dblHeight = dblTop - dblBottom
Set rect = ActivePage.DrawRectangle( _
dblChildPinX - dblWidth * 0.5, dblChildPinY - dblHeight * 0.5 _
, dblChildPinX + dblWidth * 0.5, dblChildPinY + dblHeight * 0.5)
ActiveWindow.Select rect, visSelect
ActiveWindow.Selection.SendToBack
myRects.Add rect
Next
ActiveWindow.DeselectAll
For Each rect In myRects
ActiveWindow.Select rect, visSelect
Next
ActiveWindow.Selection.BoundingBox visTypeShape + visBBoxUprightWH, _
dblLeft, dblBottom, dblRight, dblTop
ActivePage.DrawRectangle dblLeft, dblBottom, dblRight, dblTop
Set mySelection = ActiveWindow.Selection
mySelection.DeselectAll
For Each child In myShapes
mySelection.Select child, visSelect
Next
mySelection.Rotate dblAngle * -1#, visRadians, , visRotateSelectionWithPin, dblPinX, dblPinY
Set shp = mySelection.Group
shp.Cells("Angle").Result(visRadians) = dblAngle
- 09: 名前：yoda投稿日：2005/08/28(日) 08:47
- ということは、いちいち子シェイプを四角で囲む必要はないわけで、
上のコードは、もっと省略できます。
Dim shp As Visio.Shape
Dim child As Visio.Shape
Dim dblTop As Double
Dim dblBottom As Double
Dim dblLeft As Double
Dim dblRight As Double
Dim dblPinX As Double, dblPinY As Double
Dim dblAngle As Double
Dim myShapes As Collection
Dim mySelection As Visio.Selection
Set myShapes = New Collection
Set shp = ActivePage.Shapes(1)
dblPinX = shp.Cells("PinX")
dblPinY = shp.Cells("PinY")
dblAngle = shp.Cells("Angle").Result(visRadians)
For Each child In shp.Shapes
myShapes.Add child
Next
shp.Ungroup
ActiveWindow.DeselectAll
For Each child In myShapes
ActiveWindow.Select child, visSelect
Next
ActiveWindow.Selection.BoundingBox visTypeShape + visBBoxUprightWH, _
dblLeft, dblBottom, dblRight, dblTop
ActivePage.DrawRectangle dblLeft, dblBottom, dblRight, dblTop
Set mySelection = ActiveWindow.Selection
mySelection.DeselectAll
For Each child In myShapes
mySelection.Select child, visSelect
Next
mySelection.Rotate dblAngle * -1#, visRadians, , visRotateSelectionWithPin, dblPinX, dblPinY
Set shp = mySelection.Group
shp.Cells("Angle").Result(visRadians) = dblAngle
- 10: 名前：yoda投稿日：2005/08/28(日) 08:56
- グループを、解除するのが、よくない場合は、グループ内の子シェイプを、
同じ位置にコピーペーストして、四角で囲むことも、考えられます。
しかし、やってみるとわかりますが、子シェイプを同じ位置に同じ向きで、
ページにコピーすることは、そんなに簡単ではなく、座標変換も必要に
なりそうで、かえって手間が、かかりそうな感じです。グループを解除
するほうが、ややこしい座標変換をしなくて済むので、わかりやすいと
思います。
- 11: 名前：yoda投稿日：2005/09/02(金) 10:20
- 今、思いついたのですが、グループそのものを、同じ位置にコピーする
のは、比較的簡単です。グループのコピーを作りそのコピーのグループ
を解除し、解除された子シェイプ全体を四角で囲みます。
解除した子シェイプは、消してしまいます。
こうすれば、もとのグループを解除しないで済みます。
こういう風にすると、マクロは更に簡単になります。
Dim shp As Visio.Shape
Dim shpCopy As Visio.Shape
Dim dblTop As Double
Dim dblBottom As Double
Dim dblLeft As Double
Dim dblRight As Double
Dim dblPinX As Double, dblPinY As Double
Dim mySelection As Visio.Selection
If ActiveWindow.Selection.Count = 1 Then
Set shp = ActiveWindow.Selection(1)
If shp.Type <> visTypeGroup Then
MsgBox "グループ図形をひとつだけ選択してください。"
Exit Sub
End If
Else
MsgBox "グループ図形をひとつだけ選択してください。"
Exit Sub
End If
dblPinX = shp.Cells("PinX")
dblPinY = shp.Cells("PinY")
ActiveWindow.Select shp, visDeselect + visSelect
Set shpCopy = ActivePage.Drop(shp, dblPinX, dblPinY)
shpCopy.Ungroup
Set mySelection = ActiveWindow.Selection
mySelection.BoundingBox visTypeShape + visBBoxUprightWH, _
dblLeft, dblBottom, dblRight, dblTop
ActivePage.DrawRectangle dblLeft, dblBottom, dblRight, dblTop
mySelection.Delete
ActiveWindow.Selection.SendToBack
- 12: 名前：こしら投稿日：2005/09/09(金) 15:57
- 遅くなりました。
質問を投稿したこしらです。
yoda様、色々な方法を提示頂きまして、ありがとうございます！
非常に参考になります。
自分でやっていて、コード中に疑問が生じましたので、
書きたいと思います。 BoundingBox の引数のことです。
引数として対象シェイプのタイプを指定する必要が
あるのでしょうか？ 教えて頂いたVBのコード中に
>....BoundingBox visTypeShape + visBBoxUprightWH ....
というのがあるのですが、
マニュアルなどの説明では別項目の表になっていたので
引数には visTypeShape などは指定できないのでは
ないのでしょうか。
色々と試行錯誤した結果沸いた疑問です。
よろしくお願い致します。
- 13: 名前：yoda投稿日：2005/09/09(金) 20:20
- まことにお恥ずかしい話ですが、私には、Ｈｅｌｐに書いてある定数の
意味がよくわかりませんでした。そこで、片っ端から定数を入れて
試して見まして、うまくいったのは、それだけといった按配でした。
ほかにもっといいのがあるのかも知れませんが、うまく動いたと、
思ったところで、力つきました。
■トップに戻る リロード 全レスを表示
|