Calculate Walking Length

[MDC]

Hallo Tommy,

For a little part of thesis in production management I am making a walking analysis of several operators in their work stations. I made a floor plan on AutoCAD and I draw the walking paths with splines. After the total walking path is drawn, I convert them to polylines to be able to measure the walking distance. The walking path for each station is drawn in a different layer.

I'm searching for a program to calculate the total walking length per Station immediately. I saw your program for "LINES", but as I am not used to the VBA code in AutoCAD, I am not able to rewrite your program for polylines. Could you help me to say what should be changed in the code so it works for polylines?

This would safe me a lot of mouse-clicking time!

Thanks in advance
Maarten

[RICVB]

Hallo Tommy,

For a little part of thesis in production management I am making a walking analysis of several operators in their work stations. I made a floor plan on AutoCAD and I draw the walking paths with splines. After the total walking path is drawn, I convert them to polylines to be able to measure the walking distance. The walking path for each station is drawn in a different layer.

I'm searching for a program to calculate the total walking length per Station immediately. I saw your program for "LINES", but as I am not used to the VBA code in AutoCAD, I am not able to rewrite your program for polylines. Could you help me to say what should be changed in the code so it works for polylines?

This would safe me a lot of mouse-clicking time!

Thanks in advance
Maarten


just replace "LINE" with "LWPOLYLINE" in GetItems() function

[Bob Phillips]

Sorry RCVIB, I thought your comment was related to the original thread, I would have moved it as well if I had realised (I am not an AutoCad user :)).

[RICVB]

Sorry RCVIB, I thought your comment was related to the original thread, I would have moved it as well if I had realised (I am not an AutoCad user :)).

no problem at all. It only matters that Maarten gets it

[Tommy]

Good Morning MDC,

Has what RICVB helped you? If not let me know and I will get on it.

[Tommy]

FWIW just changing the "LINE" to "LWPOLYLINE" works with this code as posted.


Function Aset(iSSetName As String) As AcadSelectionSet Dim ssetA As AcadSelectionSet
On Error Resume Next
Set ssetA = ThisDrawing.SelectionSets.Add(iSSetName)
If Err.Number <> 0 Then
Set ssetA = ThisDrawing.SelectionSets(iSSetName)
ssetA.Delete
Set ssetA = ThisDrawing.SelectionSets.Add(iSSetName)
Err.Clear
End If
On Error GoTo 0
Set Aset = ssetA
End Function
Function GetItems() As AcadSelectionSet
Dim mTemp As AcadSelectionSet
Dim gpCode(3) As Integer
Dim dataValue(3) As Variant
Dim groupCode As Variant
Dim dataCode As Variant
gpCode(0) = -4
dataValue(0) = "<and"
gpCode(1) = 8
dataValue(1) = ThisDrawing.ActiveLayer.Name
gpCode(2) = 0
dataValue(2) = "LWPOLYLINE"
gpCode(3) = -4
dataValue(3) = "and>"
Set mTemp = Aset("LINESUM")
groupCode = gpCode
dataCode = dataValue
ZoomExtents
a = ThisDrawing.GetVariable("EXTMIN")
b = ThisDrawing.GetVariable("EXTMAX")
mTemp.Select acSelectionSetAll, a, b, groupCode, dataCode
Set GetItems = mTemp
End Function


Sub GetSumofLinesInActiveLayer()
Dim LineCount As AcadSelectionSet, mCntr&, mTotalLength#
Set LineCount = GetItems
LineCount.Highlight True
For mCntr = 0 To LineCount.Count - 1
mTotalLength = mTotalLength + LineCount(mCntr).Length
Next
MsgBox mTotalLength
LineCount.Highlight False
LineCount.Delete
Set LineCount = Nothing
ThisDrawing.Regen acActiveViewport
End Sub