Форум программистов CodeGuru
26 Сентябрь 2018, 17:00:04 *
Добро пожаловать, Гость. Пожалуйста, войдите или зарегистрируйтесь.

Войти
Новости:
 
   Начало   Помощь Войти Регистрация  
Страниц: [1]   Вниз
  Печать  
Автор Тема: Построение матрицы вариантов раскроя  (Прочитано 17310 раз)
0 Пользователей и 1 Гость смотрят эту тему.
max1m9
Новичок
*
Офлайн Офлайн

Сообщений: 3


Просмотр профиля
« : 07 Июнь 2010, 17:33:39 »

Здравствуйте!Хотел бы спросить совета хорошо разбирающихся в VBA людей(сам увлекаюсь VBA около года).
Есть следующая задача:
Пусть имеются заготовки длиной L м. Из них нужно нарезать m деталей, длины которых задаются элементами массива Li. Требуется получить матрицу A вариантов раскроя.
У меня получается следующее:
Код:
Построение матрицы вариантов раскроя
Const i0 = 8, j0 = 2 ' Координаты левой верхней ячеки «матрицы»
Dim m As Integer, N As Integer, L As Single
Dim Li() As Single, Ki() As Integer
' Создание одного варианта раскроя
Sub Cre_Var(ByVal k)
Dim Lk, ii
If k >= m Then Exit Sub
Lk = 0 ' Какая общая длина предыдущих вариантов
For ii = 1 To k
Lk = Lk + Ki(ii) * Li(ii)
Next ii
L0 = L - Lk ' Остаток
k = k + 1
Ki(k) = Int(L0 / Li(k)) ' Max количество одной след. детали
Call Cre_Var(k) ' Рекурсивный вызов
End Sub
Sub Matr_Raskr()
Dim Lk, ii
L = Cells(1, 3) ' Длина заготовки
m = Cells(2, 3) ' Количество деталей
ReDim Li(1 To m) As Single ' Описываем массив «длин» деталей
ReDim Ki(1 To m) As Integer ' Описываем массив количества деталей
For i = 1 To m
Li(i) = Cells(4, i + 1) ' Формируем массив «длин» деталей
Next i
N = 0
Ki(1) = Int(L / Li(1)) ' Max количество одной 1-ой детали
For i = 1 To m - 1
Lk = 0
For ii = 1 To i
Lk = Lk + Ki(ii) * Li(ii)
Next ii
Ki(i) = Int(Lk / Li(i)) ' Max количество одной i-той детали
While Ki(i) > 0
N = N + 1
' Очистка одного варианта
For ii = i + 1 To m
Ki(ii) = 0
Next ii
' Создание нового варианта
Call Cre_Var(i)
' Вывод варианта
Call Out_Variant(N, Ki, Li)
' Очистка одного варианта
For ii = 1 To i - 1
Ki(ii) = 0
Next ii
Ki(i) = Ki(i) - 1
Wend
Next i
End Sub
' Вывод варианта
Sub Out_Variant(N, Ki, Li)
Cells(i0 + N - 1, j0 - 1) = N
Ls = 0 ' Общая длина варианта
For j = 1 To m
Cells(i0 + N - 1, j0 + j - 1) = Ki(j)
Ls = Ls + Ki(j) * Li(j)
Next j
Cells(i0 + N - 1, j0 + m + 1) = Ls
End Sub

Проблема состоит в том,что выводиться лишний вариант,при том даже превышающий имеющиеся остатки.
Записан
Страниц: [1]   Вверх
  Печать  
 
Перейти в:  

Powered by MySQL Powered by PHP Powered by SMF 1.1.21 | SMF © 2015, Simple Machines Valid XHTML 1.0! Valid CSS!