Εμφάνιση ενός μόνο μηνύματος
  #5  
Παλιά 20-10-10, 02:03
Το avatar του χρήστη nisgia
nisgia Ο χρήστης nisgia δεν είναι συνδεδεμένος
Super Moderator
Όνομα: Γιάννης
Έκδοση λογισμικού Office: Ms-Office 2007
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική
 
Εγγραφή: 12-10-2009
Περιοχή: Ηγουμενίτσα
Μηνύματα: 161
Προεπιλογή

Καλησπέρα Σάκη!

Αν το ερώτημά σου είναι: "Γίνεται βελτιστοποίηση κοπής στην Access;"
Η απάντηση είναι: Ναι, γίνεται!

Επειδή όμως ως θέμα είναι προκλητικά ενδιαφέρον, και επειδή ως μάστορας οφείλω να είμαι αλληλέγγυος σε μάστορα,
σου ετοίμασα μια διαδικασία (έτσι για αρχή) η οποία βασικά δεν ξέρω αν κάνει όσα υπόσχεται
αλλά τουλάχιστο για αρχή θα μας δώσει κάπως το έναυσμα για παραπέρα ανάπτυξη, έρευνα και εξέλιξη.

Σίγουρα εκεί έξω υπάρχουν άπειρες έτοιμες εφαρμογές για να κάνεις τη δουλειά σου όμως
όταν κάτι το κάνεις μόνο σου... έχει διαφορά!

Για να δουλέψει θα πρέπει να της δώσεις τα εξής στοιχεία:
  • Το τυποποιημένο μήκος της ράβδου σε μέτρα (όρισμα sngBarLenght).
  • Έναν πίνακα με τα μήκη των κομματιών που πρόκειται να κοπούν σε φθίνουσα σειρά (όρισμα asngPiecesLength()).
Εκείνη θα σου επιστρέψει:
  • Τον αριθμό των απαιτούμενων ράβδων (επιστρεφόμενη τιμή).
  • Έναν πίνακα με τα μήκη των κομματιών ομαδοποιημένα στις αντίστοιχες ράβδους (όρισμα asngBarPieces())
  • και αν θέλεις και το αναμενόμενο υπόλοιπο (φύρα) της κοπής σε μέτρα (προαιρετικό και ..πλεονάζον όρισμα sngWaste)

Ο κώδικάς της φαίνεται παρακάτω ενώ η διαδικασία TestCutting είναι ένα παράδειγμα κλήσης της.
Η διαδικασία εκτυπώνει τα αποτελέσματα και στο παράθυρο Immediate οπότε μπορείς για την ώρα
να βλέπεις από εκεί τα αποτελέσματα κάνοντας δοκιμές αλλάζοντας τις τιμές και το πλήθος των ζητούμενων τιμών.

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

Καλές κοπές σου εύχομαι λοιπόν και καλή συνέχεια!

Function BestCuttingBars(ByVal sngBarLenght As Single, _
asngPiecesLength() As Single, asngBarPieces() As Single, _
Optional ByRef sngWaste As Single) As Integer

'***Cutting optimization***
'By nisgia for ms-office.gr
'19-Okt-2010

Dim sngTemp As Single
Dim sngPiece As Single
Dim sngSum As Single
Dim intPos As Integer
Dim intLB As Integer
Dim intUB As Integer
Dim intBars As Integer
Dim intWastePcs As Integer
Dim i As Integer

intUB = UBound(asngPiecesLength())
intLB = LBound(asngPiecesLength())
ReDim asngBarPieces(intLB To intUB, 0 To 2)

Debug.Print "---Best---8<---Cutting----"; Now
Debug.Print
Debug.Print "Table ------------------------------"
Debug.Print vbTab; vbTab; "Item"; " Bar "; "Length(m)"; " Waste(m)"
Debug.Print vbTab; vbTab; "------------------------------"

For intPos = intLB To intUB
sngTemp = Round(asngPiecesLength(intPos), 3)

If sngTemp > 0 And sngTemp <= sngBarLenght Then
sngSum = sngSum + sngTemp
intBars = intBars + 1
asngBarPieces(intPos, 0) = intBars
asngBarPieces(intPos, 1) = sngTemp

For i = intPos + 1 To intUB
sngPiece = Round(asngPiecesLength(i), 3)
If sngPiece > 0 Then
If sngPiece > Round(sngBarLenght - sngTemp, 3) Then
'
Else
asngBarPieces(i, 0) = intBars
asngBarPieces(i, 1) = sngPiece
sngTemp = sngTemp + sngPiece
sngSum = sngSum + sngPiece
asngPiecesLength(i) = 0
End If
End If
Next i
asngBarPieces(intPos, 2) = Round(sngBarLenght - sngTemp, 3)
If asngBarPieces(intPos, 2) > 0 Then intWastePcs = intWastePcs + 1
End If
Debug.Print vbTab; vbTab; intPos + 1; _
" | " & asngBarPieces(intPos, 0); _
" | " & asngBarPieces(intPos, 1); _
Space(5 - Len(CStr(asngBarPieces(intPos, 1)))); _
" | " & asngBarPieces(intPos, 2)
Next intPos

sngWaste = Round((sngBarLenght * intBars) - sngSum, 3)
BestCuttingBars = intBars

Debug.Print vbTab; vbTab; "------------------------------"
Debug.Print "Total: "; intUB + 1; " | " & intBars; _
" | " & sngSum; " | "; sngWaste & "(" & intWastePcs & " pcs)"
End Function

Sub TestCutting()
Dim asngPieces(5) As Single 'Ο πίνακας με τα κομμάτια προς κοπή
Dim asngBarPieces() As Single 'Ο πίνακας με τα κομμάτια αντιστοιχισμένα στις βέργες
Dim intBarsNeeded As Integer 'Οι ελάχιστες απαιτητές ράβδοι
Dim sngWaste As Single 'Η ελάχιστη υπολογιζόμενη φύρα

asngPieces(0) = 5 'Πρώτο κομμάτι: 5 μέτρα
asngPieces(1) = 4.55 '...
asngPieces(2) = 4.55 '...
asngPieces(3) = 2 '...
asngPieces(4) = 1.45 '...
asngPieces(5) = 1 '...

intBarsNeeded = BestCuttingBars(6, asngPieces(), asngBarPieces(), sngWaste)
'Τώρα ο πίνακας asngBarPieces περιέχει ομαδοποιημένα τα κομμάτια στις ράβδους
'η μεταβλητή intBarsNeeded έχει τον αριθμό των απαιτούμενων ράβδων
'ενώ η μεταβλητή sngWaste το υπόλοιπο (φύρα) της κοπής
End Sub
__________________
Αν δεν το ρωτούσες, δεν θα το μαθαίναμε ποτέ...!
-----------------------------------------------
Τελικά η γνώση, αντίθετα με ό,τι μέχρι σήμερα πίστευα, είναι η φυλακή της σκέψης.
Όταν η αφετηρία είναι η ελεύθερη σκέψη, δεν χρειάζεται πλέον να φτάσεις πουθενά!

Τελευταία επεξεργασία από το χρήστη nisgia : 20-10-10 στις 13:18. Αιτία: Διόρθωση δουλειών της νύχτας.
Απάντηση με παράθεση