Consulting

Results 1 to 6 of 6

Thread: Calculate total length?

  1. #1

    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.

  2. #2
    Moderator VBAX Master Tommy's Avatar
    Joined
    May 2004
    Location
    Houston, TX
    Posts
    1,175
    Location
    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 
    
    
    Formatting tags added by mark007
    Last edited by xld; 01-02-2015 at 03:15 AM. Reason: Added code tags

  3. #3
    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.

  4. #4
    Moderator VBAX Master Tommy's Avatar
    Joined
    May 2004
    Location
    Houston, TX
    Posts
    1,175
    Location
    I have acad 2000i.

  5. #5
    just replace "LINE" with "LWPOLYLINE" in GetItems() function

  6. #6
    There are several additional routines

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •