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
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
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)
If vsoShape.OneD Then
is a more elegant way, to test, if a shape is a line or connector
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?:
vsoCell.Formula = CHR(34) & strText & CHR(34)