Длина всех линий на одном слое

Option Explicit
'----------------------------'
Dim entType As String
Dim layerName As String
Dim layerList() As String
'----------------------------'
Private Sub ComboBox1_Change()
entType = Me.ComboBox1.Text
Label3.Caption = "Total Length On Layer " & Chr(34) & layerName & Chr(34) & ":"
Me.TextBox1.SetFocus
Call TotEntLengths
End Sub
Private Sub CommandButton1_Click()
Unload Me
End Sub
Private Sub ListBox1_Click()
layerName = Me.ListBox1.Value
End Sub
Private Sub UserForm_Initialize()
Me.TextBox1.Text = ""
layerList = ListOfLayers
Me.ListBox1.List() = layerList
Dim arrType As Variant
arrType = Array("LINE", "LWPOLYLINE", "POLYLINE", "ARC", "SPLINE", "CIRCLE", "ELLIPSE")
Me.ComboBox1.List() = arrType
End Sub
Function ListOfLayers() As Variant
Dim oLayers As AcadLayers
Dim oLayer As AcadLayer
Dim arrLayers() As String
Dim i As Integer
Dim k As Integer
Set oLayers = ThisDrawing.Layers
For i = 0 To oLayers.Count - 1
Set oLayer = oLayers.Item(i)
Dim layName As String
layName = oLayer.Name
If Not layName Like "*|*" Then 'exclude XRef layers
ReDim Preserve arrLayers(0 To k) As String
arrLayers(k) = layName
k = k + 1
End If
Next
ListOfLayers = arrLayers
End Function
Function TotLen(oSset As AcadSelectionSet) As Double
Dim oEnt As AcadEntity
For Each oEnt In oSset
    If TypeOf oEnt Is AcadPolyline Or _
    TypeOf oEnt Is AcadLWPolyline Or _
    TypeOf oEnt Is AcadLine Then
        TotLen = TotLen + oEnt.Length
    ElseIf TypeOf oEnt Is AcadArc Then
        TotLen = TotLen + oEnt.ArcLength
    ElseIf TypeOf oEnt Is AcadCircle Then
        TotLen = TotLen + oEnt.Circumference
    ElseIf TypeOf oEnt Is AcadSpline Then
        TotLen = TotLen + GetCurveLength(oEnt)
    ElseIf TypeOf oEnt Is AcadEllipse Then
        TotLen = TotLen + GetCurveLength(oEnt)
    End If
Next oEnt
End Function
Function GetCurveLength(oEnt As AcadEntity) As Double
Dim sVar
sVar = 0
Dim strCom As String
With ThisDrawing
.SetVariable "USERR1", sVar
.SendCommand "(vl-load-com)" & vbCr
strCom = "(setvar " & Chr(34) & "USERR1" & Chr(34) & Chr(32) & "(vlax-curve-getdistatparam (vlax-ename->vla-object (handent " & Chr(34) & oEnt.Handle & Chr(34) & ")) (vlax-curve-getendparam (vlax-ename->vla-object (handent " & Chr(34) & oEnt.Handle & Chr(34) & ")))))" & vbCr
.SendCommand strCom
GetCurveLength = .GetVariable("USERR1")
End With
End Function
Public Sub TotEntLengths()
Dim oSset As AcadSelectionSet
Dim oEnt
Dim fcode(0 To 1) As Integer
Dim fData(0 To 1) As Variant
Dim dxfCode, dxfdata
Dim i As Integer
Dim SetName As String
' create filter
fcode(0) = 0
' include selected entity type
fData(0) = entType
' include layer name
fcode(1) = 8
fData(1) = layerName
dxfCode = fcode
dxfdata = fData
'
SetName = "$Total$"
' delete all selection sets to make sure that named selection does not exist
' Fatty's technic:
          With ThisDrawing.SelectionSets
               While .Count > 0
                    .Item(0).Delete
               Wend
          End With
' add empty selection into selectionsets collection
Set oSset = ThisDrawing.SelectionSets.Add(SetName)
' select on screen
oSset.Select acSelectionSetAll, , , dxfCode, dxfdata
If oSset.Count > 0 Then
Me.TextBox1.Text = CStr(Round(TotLen(oSset), 3))
' display result
'MsgBox CStr(Round(TotLen(oSset), 3)), vbInformation, "Total Length"
Else
MsgBox "0 selected, try again"
End If
oSset.Delete
End Sub