Acad VBA Utilities - Άθροιση μηκών ευθύγραμμων τμημάτων

Η άθροιση μηκών ευθύγραμμων τμημάτων πολλές φορές διευκολύνει τις προμετρήσεις μας . Π.χ. είναι εύκολο να υπολογίσουμε τρέχον μήκος περίφραξης σε κάποιο οικόπεδο για να προχωρήσουμε μετά σε κοστολόγηση .

Ας δούμε παρακάτω ενδεικτικό τμήμα κώδικα το οποίο βοηθά στο να αθροίζονται μήκη μεμονωμένων ευθύγραμμων τμημάτων ή και Polylines  . Υπάρχει απλό  κριτήριο σχετικά με το επίπεδο (layer) που μπορεί να ανήκουν οι γραμμές ή οι polylines . Οι γραμμές που αθροίζονται τα μήκη τους αναμένονται να βρίσκονται στο Layer "LinesLayer" και οι polylines αναμένονται στο Layer "PLinesLayer"  

Private Sub CommandButton1_Click()

' Υπολογισμός μηκών καλωδίων που αντιστοιχούν στα Layers που επιλέχτηκαν

' Προσμετρώνται Line, Pline και όχι μεμονωμένα τμήματα τόξων

Dim r1 As Double, r2 As Double

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 = "LinesLayer" Then

                    r1 = r1 + elem.Length

                ElseIf elem.Layer = "PlinesLayer" Then

                    r2 = r2 + elem.Length

                End If

            

            End If

                     

        End With

                

    Next elem

    txtres1.Text = Format$(l1, "####0.00 m")

    txtres2.Text = Format$(l2, "####0.00 m")

End Sub

Ολόκληρο το αρχείο Cad για να ξεκινήσετε τους πειραματισμούς και τις δοκιμές σας μπορείτε να το "κατεβάσετε" από εδώ .