RE:Crear *.txt con valores de matriz
hola, pues aqui va el codigo completo. Pensaba que con poner la parte que yo creía que no funcionaba era suficiente.... Hay un Userform y un Modulo.
Muchisimas gracias por anticipado....
guihe
************* MODULO1(Codigo):
Public coord_ORTO()
Public coord()
Public ptosObj As Integer
Public IncX As Double
Public IncY As Double
Public Alfa
Public Rumbo
Sub mapas()
'*** PRIMERO MUESTRA EL USERFORM, CREA LAS MATRICES Y HACE
'*** Y HACE LOS CALCULOS Y LUEGO CREA LA CARPETA CON LOS ARCHIVOS
UserForm1.Show
'*** CARPETA + ARCHIVOS
mapa = IncX & "_x_" & IncY
Dim nua
ruta = ThisWorkbook.Path
nua = FreeFile
'crea una nueva carpeta donde guardar los archivos
Set fs = CreateObject("Scripting.FileSystemObject")
On Error GoTo nohaycarpeta
Set f = fs.getfolder(ruta & "" & mapa & "_rumb1_" & Rumbo)
nohaycarpeta:
If f = "" Then
Set f = fs.createfolder(ruta & "" & mapa & "_rumb1_" & Rumbo)
End If
Resume Next
lista = f & "mapa" & Rumbo & ".txt"
Open lista For Output As #nua
For b = 1 To ptosObj
Print #nua, coord_ORTO(b, 1) & "," & coord(b, 2) & "," & coord(b, 3)
Next b
Close #nua
End
End Sub
************ USERFOR1 (Codigo):
Private Sub CommandButton1_Click()
'DECLARACIÓN DE LAS VARIABLES
Dim gridX As Integer
Dim gridY As Integer
Dim X As Double
Dim Y As Double
'Dim IncX As Double
'Dim IncY As Double
'Dim Alfa
Dim pto1x
Dim pto1y
'OPERACIONES BÁSICAS PARA SABER EL TAMAÑO DE LA MATRIZ
IncX = TextBox1.Value
IncY = TextBox2.Value
X = TextBox3.Value
Y = TextBox4.Value
Alfa = TextBox5.Value
Rumbo = TextBox5.Value
gridX = (X / IncX) - 1
gridY = (Y / IncY) - 1
ptosObj = gridX * gridY
'DECLARA LA MATRIZ ORTOGONAL
Dim coord_ORTO()
ReDim coord_ORTO(1 To ptosObj, 3)
mallaX = IncX
mallaY = IncY
'*** BUCLE PARA LA COLUMNA 1 * * * *
For i = 1 To ptosObj
coord_ORTO(i, 1) = i
Next i
'*** BUCLE PARA LA COLUMNA 2 * * * *
salto2 = 1
mallaX = IncX
For n = 1 To gridY
For k = salto2 To salto2 + gridX - 1
coord_ORTO(k, 2) = mallaX
mallaX = mallaX + IncX
If k = 1 Then
pto1x = coord_ORTO(k, 2)
End If
Next k
salto2 = (gridX * (n - 1)) + (gridX + 1)
mallaX = IncX
Next n
'*** BUCLE PARA LA COLUMNA 3 * * * *
salto1 = 1
For m = 1 To gridY
For j = salto1 To salto1 + (gridX - 1)
coord_ORTO(j, 3) = mallaX
If j = 1 Then
pto1y = coord_ORTO(j, 3)
End If
Next j
salto1 = (gridX * (m - 1)) + (gridX + 1)
mallaX = mallaX + IncX
Next m
Debug.Print pto1x
Debug.Print pto1y
'DECLARA LA MATRIZ SEGÚN EL LA HORIENTACIÓN DEL LADO MAYOR.
Alfa = -(Alfa - 90)
Alfa = (Alfa * 3.14159265359) / 180
Dim coord_INT()
ReDim coord_INT(1 To ptosObj, 3)
'*** LA COLUMNA 1 ES EL 'ID' Y NO NECESITA TRANSFORMACIONES
'*** BUCLE PARA LA COLUMNA 2 y 3 * * * *
x_min = Y
y_min = X
For xx = 1 To ptosObj
coord_INT(xx, 2) = (coord_ORTO(xx, 2) * Cos(Alfa)) + (coord_ORTO(xx, 3) * Sin(Alfa))
If coord_INT(xx, 2) < x_min Then
x_min = coord_INT(xx, 2)
fila_min = xx
End If
coord_INT(xx, 3) = (coord_ORTO(xx, 2) * Sin(Alfa)) - (coord_ORTO(xx, 3) * Cos(Alfa))
y_min = coord_INT(fila_min, 3)
Next xx
'SE DEFINE LA ULTIMA MATRIZ
Dim coord()
ReDim coord(1 To ptosObj, 3)
For xxx = 1 To ptosObj
coord(xxx, 2) = (coord_INT(xxx, 2) - (x_min - pto1x))
If TextBox5.Value = 90 Then
coord(xxx, 3) = coord_ORTO(xxx, 3)
Else
coord(xxx, 3) = (coord_INT(xxx, 3) + (pto1y - y_min))
End If
Next xxx
'********* ESCRIBE LA MARTIZ ORTOGONAL EN LA HOJA PARA COMPROBAR *********
'For ii = 1 To ptosObj
' Cells(ii, 2) = coord_ORTO(ii, 2)
' Cells(ii, 3) = coord_ORTO(ii, 3)
' Cells(ii, 4) = coord_INT(ii, 2)
' Cells(ii, 5) = coord_INT(ii, 3)
' Cells(ii, 6) = coord(ii, 2)
' Cells(ii, 7) = coord(ii, 3)
'
'Next ii
Unload UserForm1
End Sub