VBA Code to position text on connector line

  • Thread starter jimthompson5802
  • Start date
J

jimthompson5802

I'm using VBA to draw a diagram that connects shapes with the dynamic
connector. The default behaviour is to display the connector's TEXT
attribute at the halfway point of the connector.

For different connectors I'd like to position their respective TEXT field at
different points along the connector. Ideal for me is to specify some
percentage (0 to 100) of the length of the connector to position the text.
For example, if I specify 25, I'd like the text to be at the 25% distance
from the start of the line, 85 specifies the text is at 85% distance from the
start of the line.

Another ideal capaibility is that the positioning will work regardless of
the shape of the connector (straight, curved, righ-angle).

Is there an existing Visio object method that performs the above or
something similar? Or is there VBA code fragement that I can adapt for me
needs?

Any pointers will be appreciated.

Jim T
 
C

Chris Roth [Visio MVP]

Hi Jim,

If you make a connector straight, then position the text, Visio will try to
maintain that original percentage-along-the-line. So you can pre-create
connectors with pre-set text positions.

If you are working with existing connectors, it gets a bit trickier. You can
analyze the geometry of a shape using the Curves and Points properties, or
you can use the trick mentioned above in code. Here is a simple bit of VBA
that does this.

Note, this will break glued ends and not repair them, but perhaps there is
something to be learned from the code:

Sub PositionTextOnConnector()

'// Assumes a valid connector is selected:
Dim shp As Visio.Shape
Set shp = Visio.ActiveWindow.Selection(1)

'// Get the current end points:
Dim x0 As Double, y0 As Double, x1 As Double, y1 As Double

x0 = shp.Cells("BeginX").ResultIU
y0 = shp.Cells("BeginY").ResultIU
x1 = shp.Cells("EndX").ResultIU
y1 = shp.Cells("EndY").ResultIU

'// Make it a straight connector, way off the page,
'// 1-inch long:
shp.Cells("BeginX").ResultIU = -10
shp.Cells("BeginY").ResultIU = 0
shp.Cells("EndX").ResultIU = -9
shp.Cells("EndY").ResultIU = 0

DoEvents '// Allow Visio time to catch-up


'// Set the text as a fraction of the way from begin
'// to end:

'Call m_setTextPositionAsFraction(shp, 0.75)
'Call m_setTextPositionAsFraction(shp, 0.25)
Call m_setTextPositionAsFraction(shp, 0.9)


DoEvents '// Allow Visio time to catch-up

'// Restore the original end points
shp.Cells("BeginX").ResultIU = x0
shp.Cells("BeginY").ResultIU = y0
shp.Cells("EndX").ResultIU = x1
shp.Cells("EndY").ResultIU = y1

End Sub

Private Sub m_setTextPositionAsFraction(ByRef shp As Visio.Shape, _
ByVal f As Double)

shp.Cells("Controls.TextPosition").ResultIU = f
shp.Cells("Controls.TextPosition.Y").ResultIU =
shp.Cells("Height").ResultIU / 2

End Sub


I think that Visio 2010 has some new ShapeSheet functions that will make
what you want to do easier/possible from within the shape itself!

--

Hope this helps,

Chris Roth
Visio MVP

For in-depth Visio articles, Visio tutorials and free Visio shapes, stencils
and templates, check out my web site:

Visio Guy
http://www.visguy.com

For more Visio discussion, visit our forum (complete with pictures and
downloads!):

Visio Guy Forum
http://www.visguy.com/vgforum
 
A

Andy

If your using your own dynamic connector shapes, you could position
the corresponding text in your shape, Visio then attempts to maintain
this whatever the type of connector, e.g. Dynamic Connector 25,
Dynamic Connector 50 etc with the text position set appropriately. I
couldn't find a sure way of calculating the position of the text
control point for curved lines etc. Visio does a much better job at
maintaining this.
 
J

jimthompson5802

Thanks to Chris Roth, who was the first to suggest the procedure, the
solution turns out to be fairly simple. The basic algorithm is as follows:
1) Save current style of connector
2) Turn connector to straight line
3) Use basic analytic geometry to calculate a new position of the text block
4) Restore the connector style to the style saved in step 1

Here is code fragment that will randomly position the text block to
approximately between 5% to 95% of line's distance. The connectors are
already connected to other visio shapes.

Sub mysub()
Dim visApp As Visio.Application
Dim shp As Visio.Shape
Dim SaveSLOLineRouteExt As Long, SaveSLORouteStyle As Long
Dim X0 As Double, X1 As Double, Y0 As Double, Y1 As Double
Dim r As Double, sinTheta As Double, cosTheta As Double


Set visApp = GetObject(, "Visio.Application")

For Each shp In visApp.ActivePage.Shapes

If Mid(shp.Name, 1, Len("Logical Interface")) = "Logical Interface"
Then
'randomly position text field of logical interface on logical
interface line
With shp
'save current style of line
SaveSLOLineRouteExt = .CellsSRC(visSectionObject,
visRowShapeLayout, visSLOLineRouteExt).Result(visNumber)
SaveSLORouteStyle = .CellsSRC(visSectionObject,
visRowShapeLayout, visSLORouteStyle).Result(visNumber)

'make line straight for calculating the new location for
text block
.CellsSRC(visSectionObject, visRowShapeLayout,
visSLOLineRouteExt).Result(visNumber) = 1
.CellsSRC(visSectionObject, visRowShapeLayout,
visSLORouteStyle).Result(visNumber) = 16

' calculate position for text block
'get x,y coordinates of end points
X0 = .CellsSRC(visSectionObject, visRowXForm1D,
vis1DBeginX).Result(visNumber) 'beginning of line
Y0 = .CellsSRC(visSectionObject, visRowXForm1D,
vis1DBeginY).Result(visNumber)
X1 = .CellsSRC(visSectionObject, visRowXForm1D,
vis1DEndX).Result(visNumber) 'end of line
Y1 = .CellsSRC(visSectionObject, visRowXForm1D,
vis1DEndY).Result(visNumber)

'convert line coordinates to radius and angle representation
r = Sqr((X1 - X0) ^ 2 + (Y1 - Y0) ^ 2) 'length of line
cosTheta = (X1 - X0) / r 'cosine of angle
theta representing the line
sinTheta = (Y1 - Y0) / r 'sine of angle
theta representing the line

'calculate random distance for new location of text box from
start of line, between 5% and 95% of distance
r = r * (Rnd * 0.9 + 0.05)

'set x,y coordinates for new location of text box
.CellsSRC(visSectionObject, visRowTextXForm,
visXFormPinX).Result(visInches) = r * cosTheta
.CellsSRC(visSectionObject, visRowTextXForm,
visXFormPinY).Result(visInches) = r * sinTheta

'restore line style to previous type
.CellsSRC(visSectionObject, visRowShapeLayout,
visSLOLineRouteExt).Result(visNumber) = SaveSLOLineRouteExt
.CellsSRC(visSectionObject, visRowShapeLayout,
visSLORouteStyle).Result(visNumber) = SaveSLORouteStyle
End With
End If
Next
End Sub
 
C

Chris Roth [Visio MVP]

An easy way to preserve glue might be to save the original formulas instead
of values, ie:

fx0 = shp.Cells("BeginX").Formula
fy0 = shp.Cells("BeginY").Formula

Then make the connector straight, set the percentage for the text block
position, then restore fx0, fy0 *formulas* instead of ResultIU.

--

Hope this helps,

Chris Roth
Visio MVP

For in-depth Visio articles, Visio tutorials and free Visio shapes, stencils
and templates, check out my web site:

Visio Guy
http://www.visguy.com

For more Visio discussion, visit our forum (complete with pictures and
downloads!):

Visio Guy Forum
http://www.visguy.com/vgforum
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top