Insert Length of Dynamic Connectors in a Shape Property for Reporting

[Aleihsing]

Could some one help me with this:

I am trying to get the Length of each Dynamic Connectors on page. I am not sure how or if I can update the a shape property or custom property for a dynamic connector.  

This code is close, but need some help with the prop.

--aledlund wrote this

Code Select Expand


Sub LengthCalc()

Dim vsoPage As Visio.Page
Dim vsoShape As Visio.Shape
Dim strText As String
Dim UndoScopeID1 As Long

UndoScopeID1 = Application.BeginUndoScope("Manual select")

Set vsoPage = Visio.ActivePage
For Each vsoShape In vsoPage.Shapes
' if the shape has a beginx cell then it is 1d and probably a line
' or connector
If vsoShape.CellExists("beginx", False) Then
If vsoShape.Text = "" Then
strText = vsoShape.NameU
Else
strText = vsoShape.Text
End If
'
strText = strText & " is " & ComputeLineLength(vsoShape) & " ft long"
MsgBox strText

Dim vsoCell As Visio.Cell
If vsoShape.CellExists("prop.cablelength", False) Then
Set vsoCell = vsoShape.Cells("prop.cablelength")
strText = CStr(vsoShape.LengthIU)
vsoCell.Formula = strText
End If
End If

Next vsoShape

Application.EndUndoScope UndoScopeID1, True

End Sub

Public Function ComputeLineLength(ByVal shpObj As Visio.Shape) As Double

Dim lngBaseX As Double
Dim lngBaseY As Double
Dim lngNewX As Double
Dim lngNewY As Double
Dim deltaX As Double
Dim deltaY As Double
Dim lngLength As Double
Dim intCurrGeomSect As Integer
Dim intCtr As Integer
Dim intSects As Integer
Dim intRows As Integer


' assign lengthiu to working length
lngLength = shpObj.LengthIU
' if not equal zero (i.e. not  a point) then
' the v2003 bug is fixed
If lngLength <> 0 Then
' remembering that internal it is in inches not feet
ComputeLineLength = lngLength / 12
Exit Function
Else
' well we have to do it the hard way by reading geometry
' get the number of geometry sections
intSects = shpObj.GeometryCount
' we only expect to find one in a line (index 0)
If intSects = 1 Then
intCurrGeomSect = visSectionFirstComponent + 0
intRows = shpObj.RowCount(intCurrGeomSect)
' row label starts at 1
For intCtr = 2 To intRows - 1
' get the previous row
lngBaseX = shpObj.CellsSRC(intCurrGeomSect, intCtr - 1, visX).ResultIU
lngBaseY = shpObj.CellsSRC(intCurrGeomSect, intCtr - 1, visY).ResultIU
' get the new position
lngNewX = shpObj.CellsSRC(intCurrGeomSect, intCtr, visX).ResultIU
lngNewY = shpObj.CellsSRC(intCurrGeomSect, intCtr, visY).ResultIU
' figure the changes and convert to absolute
deltaX = lngNewX - lngBaseX
deltaY = lngNewY - lngBaseY
lngLength = lngLength + Sqr((deltaX * deltaX) + (deltaY * deltaY))
Next intCtr
End If
' remembering that internal it is in inches not feet
ComputeLineLength = lngLength / 12
End If

Exit Function

End Function

[Visio Guy]

Just a note: Visio 2010 added a length function in the ShapeSheet. You could simply insert a field to show this in text, or add a user cell to each connector to hold the info.

For example:

  User.someCellToHoldLengthVal = PATHLENGTH(Geometry1.Path)

[Jumpy]

Code Select Expand


If vsoShape.OneD Then


is a more elegant way, to test, if a shape is a line or connector

Code Select Expand


If vsoShape.Cells("ObjType").Result("") = 2 Then


is a way to test if the shape is a dynamic connector

To your question? What exactly is the problem, or the error code?

Maybe this works?:

Code Select Expand


vsoCell.Formula = CHR(34) & strText & CHR(34)