Stencil creation

[Thomas Winkel]

Hi,

for our project we created a function that makes all these steps with a few mouse clicks:
https://youtu.be/C4oC_wia_Pc

Original is in c#, here the same in VBA:

Code Select Expand


Sub MakeDockingShape()
    Dim shp As Visio.Shape
    Dim shp1D As Visio.Shape
    Dim shp2D As Visio.Shape
   
    If ActiveWindow.Selection.Count <> 2 Then
        MsgBox "Select 2 Shapes, one 1D the other one 2D"
        Exit Sub
    End If
   
    For Each shp In ActiveWindow.Selection
        If shp.OneD Then
            Set shp1D = shp
        Else
            Set shp2D = shp
        End If
    Next shp
   
    If shp1D Is Nothing Or shp2D Is Nothing Then
        MsgBox "One shape must be 1D, the other 2D."
        Exit Sub
    End If
   
    shp2D.OneD = True
    shp2D.Cells("LockWidth").Formula = 1
    shp2D.Cells("LockHeight").Formula = 1
    shp2D.Cells("LockRotate").Formula = 1
   
    shp2D.Cells("Width").Formula = shp2D.Cells("Width")
    shp2D.Cells("Height").Formula = shp2D.Cells("Height")
   
    shp2D.Cells("LocPinX").Formula = shp2D.Cells("LocPinX") + (shp1D.Cells("PinX") - shp2D.Cells("PinX"))
    shp2D.Cells("LocPinY").Formula = shp2D.Cells("LocPinY") + (shp1D.Cells("PinY") - shp2D.Cells("PinY"))
   
    shp2D.Cells("BeginX").Formula = shp1D.Cells("BeginX")
    shp2D.Cells("BeginY").Formula = shp1D.Cells("BeginY")
    shp2D.Cells("EndX").Formula = "GUARD(BeginX+" & shp1D.Cells("Width") & ")"
    shp2D.Cells("EndY").Formula = "GUARD(BeginY+" & shp1D.Cells("Height") & ")"
   
    shp1D.Delete
End Sub


[wapperdude]

Cool Thomas.  Nice way of avoiding grouped shape and use the 1D to establish LocPin placements.

[Thomas Winkel]

I think most of our "docking shapes" are groups.
The interesting point is that the generated shapes are protected against deformation.
That was a problem, if shape snapped to wrong connection points on placement, see attached screenshot.

[wapperdude]

LOL