避免Visio中的形状重叠

Question

我录制了一个宏，从模板中添加自定义形状，并分配给命令按钮。

当多次添加形状时，这些形状是在我之前添加的现有形状之上添加的。有什么办法可以阻止这种情况的发生吗？

Sub Circle ()
Dim DiagramServices As Integer. 
DiagramSevices=ActiveDocument.DiagramServicesEnabled. 
ActiveDocument.DiagramServicesEnabled = visServiceVersion140 + visServiceVersion150. 
ActiveDocument.Windows.ItemEx("Test").Activate. 
Application.ActiveWindow.Page.Drop Application.Documents.Item("Custom.vssx").Masters.ItemU("Circle"),9,7. 
ActiveDocument.DiagramServicesEnabled = DiagramServices. 
End Sub.

Answer 1

@堕落者，请尝试这个代码

Sub ForFallen()
' determine variable for spatially related shapes
Dim vsoReturnedSelection As Visio.Selection
' define the shape
Dim sh As Shape
' determine variable coordinates of the shape
Dim x As Integer, y As Integer
' assign initial coordinates of the shape
x = 7
y = 9
' drop shape to the point with initial coordinates
Set sh = ActivePage.Drop(Application.Documents.Item("Custom.vssx").Masters.ItemU("Circle"), x, y)
' get the set of spatially related shapes for dropped shape position
Set rel = sh.SpatialNeighbors(visSpatialOverlap, 0.25, 0)
' if shape overlapped other shapes start next loop
If rel.Count > 0 Then
' this loop is repeated until there are no overlapped shapes left under the shape
Do
' increment X-position for 2 inches
x = x + 2
' move shape to new position
sh.SetCenter x, y
' obtaining a set of spatially related shapes for a new location of shape
Set rel = sh.SpatialNeighbors(visSpatialOverlap, 0.25, 0)
Loop While rel.Count > 0
End If
End Sub

阅读更多关于SpatialNeighbors属性和SetCenter方法的信息…