LengthIU

[Mike (novice Visio user)]

I don't know where to use the LengthIU property to have all of my connectors
provide actual lengths.

Do I create a custom property for each connector?

 

[Mike (novice Visio user)]

Expansion on my original question:

what I am trying to do is download the connector lengths from visio to
access.

 

[Al Edlund]

lengthiu stopped working in v2003 (a known issue). to get the actual length
takes a little code. You can catch it with a macro similar to this.
al

Sub Macro1()

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
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

On Error GoTo CatchError

' 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
CatchError:

MsgBox "error in compute line"

End Function



"Mike (novice Visio user)" <Mike (novice Visio
user)@discussions.microsoft.com> wrote in message
news:[email protected]...

 

[Mike (novice Visio user)]

Al
I am actually using version 2002. When I tried running the code below I
received the error message "sub or function not defined" at ComputeLineLength

Mike

 

[Al Edlund]

mike,
did you also copy the function below the macro and paste it as well?
if you are at v2002 then try this.
al

Sub Macro1()

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


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 " & cstr(vsoShape.LengthIU / 12) & "
ft long"
MsgBox strText

End If

Next vsoShape

End Sub

 

[Mike (novice Visio user)]

Al

That worked one additional question is there a way to capture that output
other than writing it down?

Mike

 

[Al Edlund]

usually we would create a custom property in the shape (connector) and then
have the macro put the information in the property. example assuming you
have a custom property called CableLength.

instead of
strText = strText & " is " & cstr(vsoShape.LengthIU / 12) & "
ft long"
MsgBox strText

something like this
' need a cell definition
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

and then you can use the visio report facilities to list custom properties.

al