25 Απρ 2014

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 για να "τρέξει" το απλό πρόγραμμα . 


Δεν υπάρχουν σχόλια:

Δημοσίευση σχολίου