Question

我正在使用UserForms在页面上放置形状，而不是让用户从模具中拖放，因为我希望用户将详细信息和值放入与Access数据库保持同步的形状中。用户可以选择一个“父”形状（它本身可以是子形状，也可以不是子形状）：新形状应放在父形状的中间，并应加入父组。

这是我的代码：

Sub dropOBJ(id As Integer, descr As String, objType As String, prnt As Integer)

[...]

'Drop the shape
Dim mst As Visio.Master
Dim shp As Visio.Shape
Dim pag As Visio.Page
Dim prntGrp As Visio.Shape

Set pag = Application.ActiveWindow.Page

If Not prnt = -1 Then 'Do this if a parent shape was chosen
    Set prntGrp = getGroup(prnt, "Prop.obj_ID")
    Set mst = Application.Documents.Item("Stencil.vssx").masters.ItemU("MasterShapeC")
    Set shp = pag.Drop(mst, prntGrp.Cells("PinX"), prntGrp.Cells("PinY")) 'drop in Parent
    shp.Group                                                             'init own group
    shp.Parent.Parent = prntGrp                                           'Add to prnt group
Else 'do this if no parent shape was chosen
    Set mst = Application.Documents.Item("Stencil.vssx").masters.ItemU("MasterShape")
    Set shp = pag.Drop(mst, 3, 9)                                         'drop at coordinates
    shp.Group                                                             'init own group
End If

'Write Values in Shape Props
[...]

End Sub

如果父级形状没有父级，则此方法有效。但是，如果父形状本身有一个父形状，则新形状不会放在中心，而是放在父形状的下方和左侧，离开形状本身（分组等会很好），其位置就是错误）

我在ShapeSheets中进行了挖掘，认为问题可能在于PinX和PinY值是第一个子形状的公式。我尝试读取公式的值，并将这些数值用于pag.Drop方法，但这并没有任何改变。

也许有人知道我该如何解决。

谢谢

编辑：好的，问题是我使用的是对象页面的放置方法，但是相对于父形状的坐标。我现在不是使用pag.Drop而是使用prntGrp.Drop来获取父形状的中心，而是使用它的宽度和高度单元，因为PinX和PinY值仍然给我一些奇怪的结果

工作代码：

    Set prntGrp = getGroup(prnt, "Prop.obj_ID")
    xVal = prntGrp.Cells("Width") * 0.5
    yVal = prntGrp.Cells("Height") * 0.5
    Set mst = Application.Documents.Item("Stencil.vssx").masters.ItemU("MasterShapeC")
    Set shp = prntGrp.Drop(mst, xVal, yVal) 'drop in Parent

VISIO VBA-在现有形状中放置形状

0 个答案: