I want to calculate total length (sum of all individual demission of lines) of lines present in current layer in AutoCAD using VBA.
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!!
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
Last edited by Bob Phillips; 01-02-2015 at 03:15 AM. Reason: Added code tags
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
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():
after which you get all current layer line lengths stored in lineLengths() arraySub 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