Acad VBA Utilities - Απλός υπολογισμός εμβαδού επιχρισμάτων - βαφών κ.λ.π.

Οι αυτόματες προμετρήσεις βολεύουν όταν υπάρχουν τυποποιημένες εργασίες για τον υπολογισμούς . Αν λοιπόν θέλουμε να υπολογίσουμε εμβαδά επιχρισμάτων - χρωματισμών , αρκεί να αθροίσουμε μήκη ή περίμετρο του χώρου και να υπολογίσουμε το γινόμενο με το σταθερό (συνήθως) ύψος ορόφου . Για να υπολογίσουμε χρωματισμούς ταβανιών , απλά βρίσκουμε το εμβαδό της κλειστής PolyLine που αντιστοιχεί στο περίγραμμα της οροφής .

Δείτε παρακάτω ένα τμήμα κώδικα σε Autocad VBA το οποίο αυτοματοποιεί παρόμοιου τύπου εργασίες :

Public Sub YpologiseEmbadaXrwmatismwn()

  Dim l As Double

  Dim i As Integer

  Dim r As String

  Dim sset As Object

  Dim hh As Double

   

        tl = 0

        k = 1

        

    MsgBox ("Select only lines : ")

        

    Set sset = ThisDrawing.SelectionSets.Add("SS1")

    sset.SelectOnScreen

    

    i = 0

    For Each elem In sset

        With elem

        

                If StrComp(.EntityName, "AcDbLine", 1) = 0 Then

                    i = i + 1

                    l = l + elem.Length

                

               End If

                                  

        End With

                

    Next elem

    

    hh = InputBox("Ύψος Ορόφου : ", "Δώσε το σταθερό ύψος ορόφου")

    

    r = Str$(i) + " γραμμές επιλέχτηκαν " + Chr$(10) + Chr$(13)

    r = r + "Εμβαδό για χρωματισμούς  : " + Format$(hh * l, "###0.00") & " m2"

     MsgBox r

    

    sset.Delete

    

    Set acad = Nothing

End Sub

Εναλλακτικά , κατεβάστε ένα απλό πρόγραμμα από εδώ .
Όταν φορτωθεί το σχέδιο , αποδεχτείτε την ενεργοποίηση των μακροεντολών και μετά πατείστε Alt F8 και RUN για να "τρέξει" το απλό πρόγραμμα .