Which field is that cow in?

I reader of one of my earlier posts, Copy Data from one Shape to Another ( see https://davidjpp.wordpress.com/2009/02/02/copying-data-from-one-shape-to-another/ ) asked how a cow can inherit the field number of from the field that it in. I think that this is just an example of how you can automatically update any Shape Data value from an underlying container, but I will use a cow in a field example anyway. This example uses VBA code, but should be good to use in any version of Visio since Visio 2000.

I created a field shape, actually just a filled green rectangle with a brown dash line, with a single Shape Data row, Prop.FieldName. I also created a cow shape from Clip Art, and added two Shape Data rows, Prop.Name and Prop.InField. I also added an optional third Shape Data row, Prop.Quadrant, to add extra precision, if required.

So that you can easily see what the value is in the Prop.Name and Prop.InField rows, I inserted a custom formula into the text of the Cow shape:

=Prop.Name & IF(STRSAME(Prop.InField,””),” is not in a field”,” is in quadrant ” & Prop.Quadrant & ” of the “& Prop.InField & ” field”)

Thus, you can see which field the cow is in, and even which part of the field.

image

Obviously, you can type in the name (and quadrant) of the field that the cow is in, but you want it to update automatically whenever a cow is dropped into a field; moved between fields; moved out of any field; or even if the name of the field is changed.  To do this, I added a formula in the EventXFMod cell of the Events section of the Cow shape.

image

The formula is:

=CALLTHIS(“GetContainerProp”,,”Prop.InField”,”Prop.FieldName”, “Prop.Quadrant”)

This is a call to the GetContainerProp macro with the parameters Prop.InField , Prop.FieldName and Prop.Quadrant.

The VBA method, GetContainerProp , is based on the ListShapesThatContain example in the Shapes \ Spatial Neighbor List in the Visio SDK Code Samples Library.

Public Sub GetContainerProp(ByVal shp As Visio.Shape, _

    ByVal shpProp As String, ByVal containerProp As String, _

    ByVal quadrantProp As String)

    

Dim vsoShapeOnPage As Visio.Shape

Dim intTolerance As Integer

Dim vsoReturnedSelection As Visio.Selection

Dim strSpatialRelation As String

Dim intSpatialRelation As VisSpatialRelationCodes

 

    'Abort if source cell not found

    If shp.CellExistsU(shpProp, Visio.visExistsAnywhere) = 0 Then

        Exit Sub

    Else

        'Remove current formula

        shp.CellsU(shpProp).FormulaForceU = "="""""

        If Not shp.CellExistsU(quadrantProp, Visio.visExistsAnywhere) = 0 Then

            shp.CellsU(quadrantProp).FormulaForceU = "="""""

        End If

    End If

 

    'Initialize string

    strSpatialRelation = ""

 

    'Set tolerance argument

    intTolerance = 0

 

    'Set Spatial Relation argument

    intSpatialRelation = visSpatialContainedIn + visSpatialTouching + visSpatialOverlap

 

    'Get the set of spatially related shapes

    'that meet the criteria set by the arguments.

    Set vsoReturnedSelection = shp.SpatialNeighbors _

        (intSpatialRelation, intTolerance, 0)

 

    'Evaluate the results.

    If vsoReturnedSelection.Count = 0 Then

        'No shapes met the criteria set by

        'the arguments of the method.

    Else

        'Check each shape in the selection

        For Each vsoShapeOnPage In vsoReturnedSelection

            'Abort if target cell not found

            If Not vsoShapeOnPage.CellExistsU(containerProp, _

                    Visio.visExistsAnywhere) = 0 Then

                'Check that the source Pin is over the container

                If vsoShapeOnPage.HitTest(shp.Cells("PinX").ResultIU, _

                        shp.Cells("PinY").ResultIU, 0) Then

                    shp.CellsU(shpProp).FormulaForceU = _

                        "=GUARD(" & vsoShapeOnPage.NameID & "!" & containerProp & ")"

                    'Enter formula in the optional quadrant cell

                    If Not shp.CellExistsU(quadrantProp, Visio.visExistsAnywhere) = 0 Then

                        shp.CellsU(quadrantProp).FormulaForceU = _

                            "=GUARD(RECTSECT(" & vsoShapeOnPage.NameID & "!Width, " & _

                                vsoShapeOnPage.NameID & "!Height," & _

                                "PinX - (" & vsoShapeOnPage.NameID & "!PinX - " & _

                                    vsoShapeOnPage.NameID & "!LocPinX + " & _

                                    vsoShapeOnPage.NameID & "!Width * 0.5 ), " & _

                                "PinY - (" & vsoShapeOnPage.NameID & "!PinY - " & _

                                    vsoShapeOnPage.NameID & "!LocPinY + " & _

                                    vsoShapeOnPage.NameID & "!Height * 0.5) , 0 ))"

                    End If

                    Exit For

                End If

            End If

        Next vsoShapeOnPage

    End If

 

End Sub

This code works by utilizing the Shape.SpatialNeighbors property to get a list of the shapes that the cow is contained in; touching or overlapping (these are the Relation parameter). Each shape in this list is checked to see if has the required container cell, and, if it does, the Shape.HitTest method is used to check that the feet of the cow (its PinX and PinY) are in the field. To have a closer approximation of the cows feet position, and changed the LocPinY of the cow shape to be Height*0.

image

It is worth noting that the default for the SpatialNeighbors property is to include Visible geometry sections, and in the case of the imported Clip Art image that I used, it worked because a Geometry section existed with Geometry1.NoShow = FALSE, even though there is no fill or lines.

image

Note that the quadrant numbers for the RECTSECT() function start on the right, then increase anticlockwise:

image

There two cases that are not covered by my example, namely, when a field is deleted or moved away from any cows that are in it. The latter case can be handled by fixing the PinX and PinY of the Cow to be relative to the underlying field, but the former case needs code to react to the missing field. This can be done, but is beyond the scope of this post. In any case, I would recommend using events in an Add-In (usually vb.net or C#) for a more complete and robust solution, since lots of simultaneous individual calls with CALLTHIS() in VBA will degrade performance at some point.

Download the example Visio file from http://cid-3350d61bc93733a9.office.live.com/self.aspx/Blogs/WhichFieldIsTheCowIn.vsd

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

Chris Webb's BI Blog

Microsoft Analysis Services, MDX, DAX, Power Pivot, Power Query and Power BI

davecra.wordpress.com/

Microsoft Office 365 Development, and more...

PowerShell.Amsterdam

Automate, Accelerate, Accurate

johnvisiomvp

Life with Visio and other Microsoft Toys!

Title (Required)

Windows Server Essentials Tips & Tricks

Nilsandrey's Weblog

Just another WordPress.com weblog

Things that Should be Easy

Every so often (too often in the IT industry) I encounter things that should have been very easy to do but turned out to be far too complicated. My favorite topics include SharePoint, .Net development, and software architecture, especially distributed systems.

Visio Guy

Shapes, Stencils, Drawings Templates, Tutorials, Tips & Developer Info for Microsoft Visio

Hannes's Virtual Earth

Tips & Tricks around Mapping and Cloud Computing

Pluralsight blog

be smart, be clear, be visual ...

%d bloggers like this: