Calculate total length?

I want to calculate total length (sum of all individual demission of lines) of lines present in current layer in AutoCAD using VBA.

Hi VB_IT,

Welcome to VBA Express!! :hi:

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.

Code:

---

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

---

Thank you Very much,

It working fine in simple drawing
But when I apply it on my actual complex drawing it give me wrong length (Program count of lines is larger then actual count!?)

If you say I can send you my Actual Drawing.

I have acad 2000i.

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

There are several additional routines

Quote:

---

Originally Posted by Mdos568

There are several additional routines

---

Thank you all for posting. This is pretty close to what I am looking for but...

instead of summing the total length of all lines on the current layer. How would this code be modified to display (or read in to variables) length values for each line segment on the current layer?

Thank you in advance!

Quote:

---

Originally Posted by onelinediag

Thank you all for posting. This is pretty close to what I am looking for but...

instead of summing the total length of all lines on the current layer. How would this code be modified to display (or read in to variables) length values for each line segment on the current layer?

Thank you in advance!

---

you only need a slight change in the GetSumofLinesInActiveLayer() loop, which I would then rename after GetLenghtsOfLinesInActiveLayer():

Code:

---

Sub GetLenghtsOfLinesInActiveLayer()
    Dim mCntr As Long
    With GetItems
        ReDim lineLengths(0 To .Count - 1) As Double
        For mCntr = 0 To .Count - 1
            lineLengths(mCntr) = .Item(mCntr).Length
        Next
        .Delete
    End With
    ThisDrawing.Regen acActiveViewport
   
    'a loop to show what lenghts have been stored in lineLengths() array
    Dim lineLength As Variant
    For Each lineLength In lineLengths
        MsgBox lineLength
    Next
End Sub

---

after which you get all current layer line lengths stored in lineLengths() array