Calculate total length?

[Tommy]

Hi VB_IT,

Welcome to VBA Express!!

The below code will select all items in the active layer that are lines. Then it will get a sum of their lengths and display it in a message box.

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) = "LINE"
    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