Attribute VB_Name = "Module4"
Option Explicit
Public t1()
Public tp()
Sub representación()
Dim k As Integer
ReDim Y1(2, a)
ReDim t1(a, a)
ReDim tp(2, a)
'hagamos cero los elementos de la matriz
For i = 1 To a
For j = 1 To a
t1(j, i) = 0
Next
Next
'busquemos la situación más ventajosa para colocar los siguientes departamentos
t1(Int(a / 2), Int(a / 2)) = -1E+42
Y1(1, 1) = Int(a / 2)
Y1(2, 1) = Int(a / 2)
Dim i3 As Integer
Dim j3 As Integer
Dim n As Integer
Dim ao, bo, ro, so As Integer
Dim vo, uo, wo As Integer
For k = 2 To a
'cero los elementos de la matriz cada vez q metemos un nuevo departamento
For i = 1 To a
For j = 1 To a
t1(j, i) = 0
Next
Next
'-------
'evaluamos cada departamento colocado con respecto al que se va a colocar
For n = 1 To k - 1
For i3 = 1 To 3
For j3 = 1 To 3
If i3 = 2 Or j3 = 2 Then
t1(Y1(1, n) + j3 - 2, Y1(2, n) + i3 - 2) = t1(Y1(1, n) + j3 - 2, Y1(2, n) + i3 - 2) + mla(va(k) + 3, va(n))
ElseIf i3 = j3 Then
t1(Y1(1, n) + j3 - 2, Y1(2, n) + i3 - 2) = t1(Y1(1, n) + j3 - 2, Y1(2, n) + i3 - 2) + 0.5 * mla(va(k) + 3, va(n))
ElseIf i3 = 1 And j3 = 3 Then
t1(Y1(1, n) + j3 - 2, Y1(2, n) + i3 - 2) = t1(Y1(1, n) + j3 - 2, Y1(2, n) + i3 - 2) + 0.5 * mla(va(k) + 3, va(n))
ElseIf i3 = 3 And j3 = 1 Then
t1(Y1(1, n) + j3 - 2, Y1(2, n) + i3 - 2) = t1(Y1(1, n) + j3 - 2, Y1(2, n) + i3 - 2) + 0.5 * mla(va(k) + 3, va(n))
End If
Next
Next
Next
For i3 = 1 To a
t1(Y1(1, i3), Y1(2, i3)) = -1E+42
Next
'ahora recorremos la matriz buscando la coordenada con mayor peso
For ro = 1 To a
For so = 1 To a
vo = t1(ro, so)
ao = ro
bo = so
For uo = 1 To a
For wo = 1 To a
If vo <= t1(uo, wo) Then
vo = t1(uo, wo)
ao = uo
bo = wo
End If
Next
Next
Next
Next
Y1(1, k) = ao
Y1(2, k) = bo
t1(ao, bo) = -1E+42
If Form4.Check1.Value = 1 Then
Form3.Text5.Text = Form3.Text5.Text & Space(2) & vo
'_______________________________________________________________________________________
Dim cad As String
For i = 1 To a
'fila
For j = 1 To a
If Len(t1(j, i)) > 6 Then
cad = Mid(t1(j, i), 1, 6) & Space(2)
Else
cad = t1(j, i) & Space(2 + 6 - Len(t1(j, i)))
End If
Form3.Text3.Text = Form3.Text3.Text & cad
Next
Form3.Text3.Text = Form3.Text3.Text & vbCrLf
Form3.Text4.Text = Form3.Text4.Text & Y1(1, i) & Space(3) & Y1(2, i) & vbCrLf
Next
Form3.Text3.Text = Form3.Text3.Text & "______________________________________________________________________________________________________________________________________________________________________" & vbCrLf
Form3.Text4.Text = Form3.Text4.Text & "___" & vbCrLf
'_______________________________________________________________________________________
End If
Next
'colocación de los departamentos de acuerdo a la distribución calculada
For i = 1 To a
Form5.Text1(i).Left = 4200 + Y1(1, i) * 820
Form5.Text1(i).Top = 1320 + Y1(2, i) * 820
Form5.Text1(i).Visible = True
Next
For i = 1 To a
tp(2, i) = Form5.Text1(i).Left
tp(1, i) = Form5.Text1(i).Top
Next
'PRESENTEMOS EN LA LISTA LOS DEPARTAMENTOS ORDENADOS
For i = 1 To a
Form5.List1.Font = "COURIER NEW"
If i < 10 Then
Form5.List1.AddItem i & ".- " & va(i)
Else
Form5.List1.AddItem i & ".- " & va(i)
End If
Next
Form5.Show
End Sub
e-REdING. Biblioteca de la Escuela Superior de Ingenieros de Sevilla.
