PDA

View Full Version : Calculate total length?



VB IT
04-02-2006, 04:29 AM
I want to calculate total length (sum of all individual demission of lines) of lines present in current layer in AutoCAD using VBA.

Tommy
04-02-2006, 10:51 AM
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.



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

VB IT
04-03-2006, 03:54 AM
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.

Tommy
04-03-2006, 06:14 AM
I have acad 2000i.

RICVB
01-02-2015, 01:14 AM
just replace "LINE" with "LWPOLYLINE" in GetItems() function

Mdos568
03-16-2017, 09:49 AM
There are several additional routines

onelinediag
10-25-2017, 01:24 PM
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!

RICVB
10-30-2017, 07:41 AM
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():


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