Get total length of multiple lines - different approach

I have multiple lines each with individual number (tag). I have excel with many traces consisting of different line numbers. I want to calculate total lengths of that traces based on excel.
eg
2 - length 1, 4-length 2, 7-length 3
traces in excel
2 4 7 - total length will be 6
2 7 - total length will be 4
4 7 - total legth will be 5

I have pretty decent macro that works well on small drawings but is very slow on big ones. Searching for individual number it scans whole lines in the drawing each time.
I want to try different approach. I want to do just one scan to assign lengths values to proper line numbers and then do the math. Problem is I don't know how to do that

here is my current code

Sub GetTracesLength()
Dim xlPath As String
xlPath = Replace(ActiveDesignFile.FullName, "dgn", "xlsx")
Dim xlApp As Excel.Application
Dim xlWorkbook As Excel.Workbook
Dim xlWorksheet As Excel.Worksheet
Set xlApp = New Excel.Application
xlApp.Visible = True
Set xlWorkbook = xlApp.Workbooks.Open(xlPath, ReadOnly:=False)
Set xlWorksheet = xlApp.ActiveWorkbook.Worksheets("Worksheet")

Dim x As Long
Dim LastRow As Long

LastRow = xlWorksheet.Cells(xlWorksheet.Rows.count, "A").End(xlUp).Row

Dim xlTrace As String
For x = 6 To LastRow
If xlWorksheet.Cells(x, "A") = "NIEUW" Then
xlTrace = xlWorksheet.Cells(x, "N")

Dim xlTraceSplit() As String
Dim i As Long
Dim cLength As Double
cLength = 0
xlTraceSplit = Split(xlTrace, " ")
For i = LBound(xlTraceSplit) To UBound(xlTraceSplit)
cLength = cLength + getCableLength(xlTraceSplit(i))
Next i

xlWorksheet.Cells(x, "Q") = Format(cLength, "#0.00")
End If
Next
xlWorkbook.Close SaveChanges:=True
xlApp.Application.Quit
End Sub

Function getCableLength(gNr As String) As Double


Dim oScanCriteria As ElementScanCriteria
Set oScanCriteria = New ElementScanCriteria

oScanCriteria.ExcludeAllTypes
oScanCriteria.IncludeType msdElementTypeLine
oScanCriteria.IncludeType msdElementTypeLineString

Dim oScanEnumerator As ElementEnumerator
Set oScanEnumerator = ActiveModelReference.Scan(oScanCriteria)

Dim oElement As LineElement

Do While oScanEnumerator.MoveNext
Set oElement = oScanEnumerator.Current

If InStr(oElement.AsLineElement.Level.Name, "VERWIJDEREN") = 0 And InStr(oElement.AsLineElement.Level.Name, "GIL") = 0 Then

If (oElement.HasAnyTags) Then
Dim oTags() As TagElement
Dim tag As Integer
oTags = oElement.GetTags()
For tag = LBound(oTags) To UBound(oTags)
If oTags(tag).TagDefinitionName = "gil-nummer" Then
If Not IsNumeric(oTags(tag).Value) Then'do nothing
ElseIf oTags(tag).Value = gNr Then
getCableLength = oElement.Length
Exit Function
End If
End If
Next tag
End If
End If
Loop
End Function

a piece of code would be very helpful

greets
Sławek