04-06-22, 11:14 AM (آخر تعديل لهذه المشاركة : 04-06-22, 11:15 AM {2} بواسطة Lathe1.)
السلام عليكم عندى مشروع بالسى شارب حولته الى فيجول بيسك 2019 من موقع التحويل ولكن عند وضعة فى مشروع جديد يعطى اخطاء كثيرة
ساقوم برفع المشوعيين باللغتين و ارجو الحل
(04-06-22, 11:14 AM)Lathe1 كتب : السلام عليكم عندى مشروع بالسى شارب حولته الى فيجول بيسك 2019 من موقع التحويل ولكن عند وضعة فى مشروع جديد يعطى اخطاء كثيرة
ساقوم برفع المشروعيين باللغتين و ارجو الحل
Class LinerCuttingClass
Private desiredLengths As List(Of Integer)
Private amount As List(Of Integer)
Private whipLength As Integer
Private endSawCut As Integer
Private toolWidth As Integer
Private headlessRetreat As Integer
Private cuts As List(Of List(Of Integer))
Private repeats As List(Of Integer)
Private retreats As List(Of Integer)
Private usingLength As List(Of Integer)
Private schet As Double() = {0, 0, 0, 0}
Private schetDl As Double() = {0, 0, 0, 0}
Private cut, bez, torc, line, maxNumb, maxNumbMem As Integer
Private x, j, i, y, zvr, hl, pop, verif As Integer
Private maxRes, sum, sdv, pov As Integer
Private l As Integer()
Private k As Integer()
Private z As Integer() = New Integer(200) {}
Private zost As Integer() = New Integer(200) {}
Private lovr As Integer(,) = New Integer(200, 200) {}
Private kvr As Integer(,)
Private maxNumbVr As Integer() = New Integer(200) {}
Private sumLine As Integer() = New Integer(200) {}
Private lvr As Integer(,)
Private q As Integer() = New Integer(30000) {}
Private w As Integer() = New Integer(30000) {}
Private lo As Integer(,) = New Integer(200, 200) {}
Private kol As Integer() = New Integer(200) {}
Private p As Integer() = New Integer(200) {}
Private res As Integer(,)
Public Function GetCuts() As List(Of List(Of Integer))
Return cuts
End Function
Public Function GetRepeats() As List(Of Integer)
Return repeats
End Function
Public Function GetRetreats() As List(Of Integer)
Return retreats
End Function
Public Function GetUsingLength() As List(Of Integer)
Return usingLength
End Function
Public Sub New(ByVal desiredLengths_ As List(Of Integer), ByVal amount_ As List(Of Integer), ByVal whipLength_ As Integer, ByVal endSawCut_ As Integer, ByVal toolWidth_ As Integer, ByVal headlessRetreat_ As Integer)
desiredLengths = New List(Of Integer)(desiredLengths_)
amount = New List(Of Integer)(amount_)
whipLength = whipLength_
endSawCut = endSawCut_
toolWidth = toolWidth_
headlessRetreat = headlessRetreat_
Calculate()
End Sub
Private Sub CutMass()
For i = w(y) To maxNumbVr(x) - 1
kvr(i, x) = kvr(i + 1, x)
lvr(i, x) = lvr(i + 1, x)
Next
kvr(maxNumbVr(x), x) = 0
lvr(maxNumbVr(x), x) = 0
End Sub
Private Sub BaseLine()
zvr = line / l(1)
If zvr > k(1) Then zvr = k(1)
For i = 2 To maxNumb
kvr(i, j) = k(i)
lvr(i, j) = l(i)
Next
Next
If kvr(1, zvr) = 0 Then
x = zvr
CutMass()
End If
End Sub
Private Sub Optimiz()
Dim len As Integer = line - sumLine(x)
Dim L As Integer
Dim dif As Integer
For i = 1 To len
q(i) = 0
w(i) = 0
For j = 1 To maxNumbVr(x)
L = lvr(j, x)
dif = i - L
If dif = 0 Then
q(i) = L
w(i) = j
ElseIf dif > 0 AndAlso q(i) < (q(dif) + L) Then
q(i) = q(dif) + L
w(i) = j
End If
Next
Next
End Sub
Private Sub OstLine()
Dim kv As Integer
Dim ind As Integer = w(y)
While w(y) > 0
kv = kvr(ind, x)
If kv > 0 Then
kvr(ind, x) = kv - 1
zost(x) = zost(x) + 1
lovr(x, zost(x) + x) = lvr(ind, x)
sumLine(x) = sumLine(x) + lvr(ind, x)
y = y - lvr(ind, x)
ind = w(y)
Continue While
ElseIf maxNumbVr(x) > 1 Then
CutMass()
Optimiz()
ind = w(y)
Continue While
End If
If kv = 0 AndAlso maxNumbVr(x) = 1 Then
y = 1
Return
End If
End While
End Sub
Private Sub Result()
cuts = New List(Of List(Of Integer))()
repeats = New List(Of Integer)()
retreats = New List(Of Integer)()
usingLength = New List(Of Integer)()
Dim workpieces As List(Of Integer)
For i = 1 To hl - 1
x = 0
sum = 0
kol(i) = 1
res(i + 1, 1) = i
res(i + 1, 4) = kol(i)
repeats.Add(kol(i))
workpieces = New List(Of Integer)()
For j = 1 To z(i)
If z(i) > maxRes Then maxRes = z(i)
res(i + 1, j + 4) = lo(i, j) - cut
sum = sum + lo(i, j)
schet(3) = schet(3) + 1
schetDl(3) = schetDl(3) + lo(i, j) - cut
workpieces.Add(res(i + 1, j + 4))
If i > 1 AndAlso res(i + 1, j + 4) = res(i, j + 4) Then
x = x + 1
Else
x = 0
pov = 0
End If
Next
If x = z(i) AndAlso z(i) = z(i - 1) Then
kol(i - 1 - pov) = kol(i - 1 - pov) + 1
repeats(repeats.Count - 2) = kol(i - 1 - pov)
pov = pov + 1
usingLength.Remove(usingLength.Last())
retreats.Remove(retreats.Last())
repeats.Remove(repeats.Last())
cuts.Remove(cuts.Last())
sdv = sdv + 1
End If
Next
If schet(1) = schet(2) AndAlso schet(1) = schet(3) AndAlso schetDl(1) = schetDl(2) AndAlso schetDl(1) = schetDl(3) Then
Return
Else
Throw New Exception("Ошибка! Возможен неверный раскрой")
End If
End Sub
Private Sub Calculate()
cut = toolWidth
bez = headlessRetreat
torc = endSawCut
line = whipLength - torc
maxNumb = amount.Count
maxNumbMem = maxNumb
l = New Integer(maxNumb + 2 - 1) {}
k = New Integer(maxNumb + 2 - 1) {}
kvr = New Integer(maxNumb + 1 - 1, 200) {}
lvr = New Integer(maxNumb + 1 - 1, 200) {}
res = New Integer(maxNumb + 1 - 1, maxNumb + 1 - 1) {}
j = 1
For Each len As Integer In desiredLengths
l(j) = len + cut
If l(j) + torc > line Then Throw New Exception("Деталь " & j & " длиннее исходной заготовки")
k(j) = amount(j - 1)
schet(1) += k(j)
schetDl(1) += (l(j) - cut) * k(j)
j += 1
Next
Dim vl As Integer
Dim vk As Integer
For i = 1 To maxNumb - 1
For j = i + 1 To maxNumb
If l(j) > l(i) Then
vl = l(j)
vk = k(j)
l(j) = l(i)
k(j) = k(i)
l(i) = vl
k(i) = vk
End If
Next
Next
hl = 1
z(1) = 0
y = line
While k(1) > 0
For i = 1 To 100
zost(i) = 0
Next
BaseLine()
For x = 1 To zvr
y = line - sumLine(x)
Optimiz()
OstLine()
Next
p(1) = zost(1) + 1
pop = 1
For x = 2 To zvr
verif = line - sumLine(x) - bez
If verif < 0 Then
p(x) = x + zost(x)
If p(x) < p(x - 1) Then pop = x
ElseIf sumLine(x) > sumLine(x - 1) Then
pop = x
End If
Next
For i = 1 To pop
lo(hl, i) = l(1)
k(1) = k(1) - 1
schet(2) = schet(2) + 1
schetDl(2) = schetDl(2) + lo(hl, i) - cut
Next
04-06-22, 04:46 PM (آخر تعديل لهذه المشاركة : 04-06-22, 04:49 PM {2} بواسطة Lathe1.)
[attachment=27844 كتب :bidaya pid='182628' dateline='1654340467']
كود :
Class LinerCuttingClass
Private desiredLengths As List(Of Integer)
Private amount As List(Of Integer)
Private whipLength As Integer
Private endSawCut As Integer
Private toolWidth As Integer
Private headlessRetreat As Integer
Private cuts As List(Of List(Of Integer))
Private repeats As List(Of Integer)
Private retreats As List(Of Integer)
Private usingLength As List(Of Integer)
Private schet As Double() = {0, 0, 0, 0}
Private schetDl As Double() = {0, 0, 0, 0}
Private cut, bez, torc, line, maxNumb, maxNumbMem As Integer
Private x, j, i, y, zvr, hl, pop, verif As Integer
Private maxRes, sum, sdv, pov As Integer
Private l As Integer()
Private k As Integer()
Private z As Integer() = New Integer(200) {}
Private zost As Integer() = New Integer(200) {}
Private lovr As Integer(,) = New Integer(200, 200) {}
Private kvr As Integer(,)
Private maxNumbVr As Integer() = New Integer(200) {}
Private sumLine As Integer() = New Integer(200) {}
Private lvr As Integer(,)
Private q As Integer() = New Integer(30000) {}
Private w As Integer() = New Integer(30000) {}
Private lo As Integer(,) = New Integer(200, 200) {}
Private kol As Integer() = New Integer(200) {}
Private p As Integer() = New Integer(200) {}
Private res As Integer(,)
Public Function GetCuts() As List(Of List(Of Integer))
Return cuts
End Function
Public Function GetRepeats() As List(Of Integer)
Return repeats
End Function
Public Function GetRetreats() As List(Of Integer)
Return retreats
End Function
Public Function GetUsingLength() As List(Of Integer)
Return usingLength
End Function
Public Sub New(ByVal desiredLengths_ As List(Of Integer), ByVal amount_ As List(Of Integer), ByVal whipLength_ As Integer, ByVal endSawCut_ As Integer, ByVal toolWidth_ As Integer, ByVal headlessRetreat_ As Integer)
desiredLengths = New List(Of Integer)(desiredLengths_)
amount = New List(Of Integer)(amount_)
whipLength = whipLength_
endSawCut = endSawCut_
toolWidth = toolWidth_
headlessRetreat = headlessRetreat_
Calculate()
End Sub
Private Sub CutMass()
For i = w(y) To maxNumbVr(x) - 1
kvr(i, x) = kvr(i + 1, x)
lvr(i, x) = lvr(i + 1, x)
Next
kvr(maxNumbVr(x), x) = 0
lvr(maxNumbVr(x), x) = 0
End Sub
Private Sub BaseLine()
zvr = line / l(1)
If zvr > k(1) Then zvr = k(1)
For i = 2 To maxNumb
kvr(i, j) = k(i)
lvr(i, j) = l(i)
Next
Next
If kvr(1, zvr) = 0 Then
x = zvr
CutMass()
End If
End Sub
Private Sub Optimiz()
Dim len As Integer = line - sumLine(x)
Dim L As Integer
Dim dif As Integer
For i = 1 To len
q(i) = 0
w(i) = 0
For j = 1 To maxNumbVr(x)
L = lvr(j, x)
dif = i - L
If dif = 0 Then
q(i) = L
w(i) = j
ElseIf dif > 0 AndAlso q(i) < (q(dif) + L) Then
q(i) = q(dif) + L
w(i) = j
End If
Next
Next
End Sub
Private Sub OstLine()
Dim kv As Integer
Dim ind As Integer = w(y)
While w(y) > 0
kv = kvr(ind, x)
If kv > 0 Then
kvr(ind, x) = kv - 1
zost(x) = zost(x) + 1
lovr(x, zost(x) + x) = lvr(ind, x)
sumLine(x) = sumLine(x) + lvr(ind, x)
y = y - lvr(ind, x)
ind = w(y)
Continue While
ElseIf maxNumbVr(x) > 1 Then
CutMass()
Optimiz()
ind = w(y)
Continue While
End If
If kv = 0 AndAlso maxNumbVr(x) = 1 Then
y = 1
Return
End If
End While
End Sub
Private Sub Result()
cuts = New List(Of List(Of Integer))()
repeats = New List(Of Integer)()
retreats = New List(Of Integer)()
usingLength = New List(Of Integer)()
Dim workpieces As List(Of Integer)
For i = 1 To hl - 1
x = 0
sum = 0
kol(i) = 1
res(i + 1, 1) = i
res(i + 1, 4) = kol(i)
repeats.Add(kol(i))
workpieces = New List(Of Integer)()
For j = 1 To z(i)
If z(i) > maxRes Then maxRes = z(i)
res(i + 1, j + 4) = lo(i, j) - cut
sum = sum + lo(i, j)
schet(3) = schet(3) + 1
schetDl(3) = schetDl(3) + lo(i, j) - cut
workpieces.Add(res(i + 1, j + 4))
If i > 1 AndAlso res(i + 1, j + 4) = res(i, j + 4) Then
x = x + 1
Else
x = 0
pov = 0
End If
Next
If x = z(i) AndAlso z(i) = z(i - 1) Then
kol(i - 1 - pov) = kol(i - 1 - pov) + 1
repeats(repeats.Count - 2) = kol(i - 1 - pov)
pov = pov + 1
usingLength.Remove(usingLength.Last())
retreats.Remove(retreats.Last())
repeats.Remove(repeats.Last())
cuts.Remove(cuts.Last())
sdv = sdv + 1
End If
Next
If schet(1) = schet(2) AndAlso schet(1) = schet(3) AndAlso schetDl(1) = schetDl(2) AndAlso schetDl(1) = schetDl(3) Then
Return
Else
Throw New Exception("Ошибка! Возможен неверный раскрой")
End If
End Sub
Private Sub Calculate()
cut = toolWidth
bez = headlessRetreat
torc = endSawCut
line = whipLength - torc
maxNumb = amount.Count
maxNumbMem = maxNumb
l = New Integer(maxNumb + 2 - 1) {}
k = New Integer(maxNumb + 2 - 1) {}
kvr = New Integer(maxNumb + 1 - 1, 200) {}
lvr = New Integer(maxNumb + 1 - 1, 200) {}
res = New Integer(maxNumb + 1 - 1, maxNumb + 1 - 1) {}
j = 1
For Each len As Integer In desiredLengths
l(j) = len + cut
If l(j) + torc > line Then Throw New Exception("Деталь " & j & " длиннее исходной заготовки")
k(j) = amount(j - 1)
schet(1) += k(j)
schetDl(1) += (l(j) - cut) * k(j)
j += 1
Next
Dim vl As Integer
Dim vk As Integer
For i = 1 To maxNumb - 1
For j = i + 1 To maxNumb
If l(j) > l(i) Then
vl = l(j)
vk = k(j)
l(j) = l(i)
k(j) = k(i)
l(i) = vl
k(i) = vk
End If
Next
Next
hl = 1
z(1) = 0
y = line
While k(1) > 0
For i = 1 To 100
zost(i) = 0
Next
BaseLine()
For x = 1 To zvr
y = line - sumLine(x)
Optimiz()
OstLine()
Next
p(1) = zost(1) + 1
pop = 1
For x = 2 To zvr
verif = line - sumLine(x) - bez
If verif < 0 Then
p(x) = x + zost(x)
If p(x) < p(x - 1) Then pop = x
ElseIf sumLine(x) > sumLine(x - 1) Then
pop = x
End If
Next
For i = 1 To pop
lo(hl, i) = l(1)
k(1) = k(1) - 1
schet(2) = schet(2) + 1
schetDl(2) = schetDl(2) + lo(hl, i) - cut
Next