Μετρήσεις επί σχεδίου - Παράδειγμα #2

Θα δούμε τώρα κάποιο παράδειγμα , μέσω κώδικα Acad VBA , το οποίο θα επιστρέφει στο σύνολο των μηκών για γραμμές που βρίσκονται σε δύο συγκεκριμένα επίπεδα του σχεδίου μας .

Χαρακτηριστική οθόνη με τα αποτελέσματα του προγράμματος .

Ο κώδικας βρίσκεται εδώ . 

Sub LLines()

Dim elem As Object
Dim l1 As Double, l2 As Double
Dim t1 As String

For Each elem In ThisDrawing.ModelSpace
        With elem
            ' When a block reference has been found,
            ' check it for attributes
            If StrComp(.EntityName, "AcDBLine", 1) = 0 Or StrComp(.EntityName, "AcDBPolyLine", 1) = 0 Then
            
                If elem.Layer = "New - 1" Then
                    l1 = l1 + elem.Length
                ElseIf elem.Layer = "New - 2" Then
                    l2 = l2 + elem.Length
                End If
            
            End If
                     
        End With
                
    Next elem

    
    t1 = "Μήκος γραμμών στο Layer 'New - 1 : '" & Format$(l1, " #####0.00") + Chr$(10) + Chr$(13)
    t1 = t1 + "Μήκος γραμμών στο Layer 'New - 2 : '" & Format$(l2, " #####0.00")

    MsgBox t1
    
End Sub

Κατεβάστε το παράδειγμα από εδώ .