Can't get length for multiple geometry!!!

[DigitalHomeSolutions]

I have been working on this for a month and I can't get it! I NEED help
please. I have been all over the net. I am trying to get the true length of a
connector not the sum of the coordinates. If I have a line that say, layman
terms, goes down, right, up, right, up on a visio drawing, how do I get the
correct length? This is what I have so far, it was given to me from another
post, I have Visio 2002 SP2:

Public Sub SetTextToLenghtIU()
Dim shp As Visio.Shape
For Each shp In Visio.ActiveWindow.Selection
GetLengthIU shp
Next shp
End Sub

Public Sub GetLengthIU(ByVal shp As Visio.Shape)
'This should work! (But it doesn't in Visio 2003)
If shp.OneD <> 0 Then
shp.Text = shp.LengthIU = (False)
End If

'Fix for simple multi-segment lines - Assumes just one geometry section with
'straight line segments
Dim dseg As Double
Dim dtotal As Double
Dim irow As Integer
Dim BeginX As Double
Dim EndX As Double
Dim BeginY As Double
Dim EndY As Double


For irow = 2 To shp.RowCount(Visio.visSectionFirstComponent)
BeginX = shp.CellsSRC(Visio.visSectionFirstComponent, irow - 1,
Visio.visX).ResultIU
BeginY = shp.CellsSRC(Visio.visSectionFirstComponent, irow - 1,
Visio.visY).ResultIU
EndX = shp.CellsSRC(Visio.visSectionFirstComponent, irow,
Visio.visX).ResultIU
EndY = shp.CellsSRC(Visio.visSectionFirstComponent, irow,
Visio.visY).ResultIU
dseg = Sqr((EndX - BeginX) ^ 2 + ((EndY - BeginY)) ^ 2)
dtotal = dtotal + dseg

Next irow

shp.Text = dtotal
End Sub

 

[David Parker]

Hi .. again.

I gave you the original reply, but it looks like I looped thru' one vertex
to far - sorry.
If you add - 1 after shp.RowCount(Visio.visSectionFirstComponent)
i.e.
For irow = 2 To shp.RowCount(Visio.visSectionFirstComponent) - 1

then you will indeed get the sum of the lengths of the segments of the
connector - not the co-ordinates as you seem to think.

However, since you are using Visio 2002 SP1 then none of this is necessary
because LengthIU works, as I said in my previous post. All you need to do
is ensure that the units are converted to your drawing units and scale if
you are using anything but inches at 1:1 (no scale)

 

[David Parker [Visio MVP]]

oh and,
shp.Text = shp.LengthIU = (False)
should read
shp.Text = shp.LengthIU

 

[Al Edlund]

this works for me,
al
Public Function ComputeLineLength(ByVal shpObj As Visio.Shape) As Double

Dim lngBaseX As Double = 0

Dim lngBaseY As Double = 0

Dim lngNewX As Double = 0

Dim lngNewY As Double = 0

Dim deltaX As Double = 0

Dim deltaY As Double = 0

Dim lngLength As Double = 0

Dim intCurrGeomSect As Integer

Dim intCtr As Integer

Dim intSects As Integer

Dim intRows As Integer

Dim sbMath As New StringBuilder

Try

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

' subLogMessage(vbCrLf & "line " & shpObj.Name.ToString & " " &
shpObj.RowCount(intCurrGeomSect).ToString)

' row label starts at 1

For intCtr = 2 To intRows - 1

' clear the string builder

' sbMath.Length = 0

' sbMath.Append("Row " & intCtr.ToString & " = ")

' get the previous row

lngBaseX = shpObj.CellsSRC(intCurrGeomSect, intCtr - 1, visX).ResultIU

' sbMath.Append(lngBaseX.ToString & " / ")

lngBaseY = shpObj.CellsSRC(intCurrGeomSect, intCtr - 1, visY).ResultIU

sbMath.Append(lngBaseY.ToString & " / ")

' get the new position

lngNewX = shpObj.CellsSRC(intCurrGeomSect, intCtr, visX).ResultIU

' sbMath.Append(lngNewX.ToString & " / ")

lngNewY = shpObj.CellsSRC(intCurrGeomSect, intCtr, visY).ResultIU

' sbMath.Append(lngNewY.ToString & " / ")

' figure the changes and convert to absolute

deltaX = lngNewX - lngBaseX

' sbMath.Append(deltaX.ToString & " / ")

deltaY = lngNewY - lngBaseY

' sbMath.Append(deltaY.ToString & " / ")

lngLength = lngLength + Math.Sqrt((deltaX * deltaX) + (deltaY * deltaY))

' sbMath.Append((Math.Sqrt((deltaX * deltaX) + (deltaY * deltaY))).ToString)

' subLogMessage(sbMath.ToString)

Next intCtr

End If

' remembering that internal it is in inches not feet

ComputeLineLength = lngLength / 12

End If

Catch err As Exception

subLogException(err)

subDisplayException(Nothing, err)

End Try

End Function

 

[DigitalHomeSolutions]

Thank you! Thank You! Thank You! I actually did that 3 weeks ago but I had
+1. I can't tell you how many headaches and hours I've spent trying to figure
that out. I learned a lot in the process though. I think I've read the entire
Help section in Visio and VB. If it were not for people like you, many of us
wouldn't know the first thing to do. We should all give our thanks. If you
have any other tips for doing floorplan wiring schematics (Home Theater,
structured wiring) please post them. Thank you again!!!