Codigo Para Dibujar en Auto Cad

Dim AcadDoc As Object
Dim AcadDocEM As Object
Dim ObjLinea As Object
Dim Pt1(1 To 3) As Double
Dim Pt2(1 To 3) As Double
Dim Pt7(1 To 3) As Double
Dim Pt8(1 To 3) As Double

Dim t(1 To 12, 1 To 12) As Double
Dim kl(1 To 12, 1 To 12) As Double
Dim tt(1 To 12, 1 To 12) As Double
Dim kg(1 To 12, 1 To 12) As Double
Dim prod(1 To 12, 1 To 12) As Double
Dim mp() As Double

'MATRIZ DE PASO, APOYO PARA LA CREACIÓN DEL mc

Dim mc() As Double

'MATRIZ ENSAMBLADA Y COMPLETA DE RIGIDEZ

Dim w As Double
Dim suma As Double
Dim a As Integer
Dim b As Double
Dim h As Double
Dim c As Double
Dim d As Double
Dim e As Double
Dim X As Double
Dim Y As Double

Dim z As Double
Dim r As Double
Dim aux1 As Double
Dim aux2 As Double
Dim aux3 As Double
Dim s(1 To 10) As Double 'CREAR MATRIZ DE RIGIDEZ
Dim lsnn() As Double

'CREA LISTA DE LOS NUMEROS DE NUDOS

Dim lsx() As Double

'CREA LISTA DE COORDENADAS EN "X"

Dim lsy() As Double

'CREA LISTA DE COORDENADAS EN "Y"

Dim lsz() As Double

'CREA LISTA DE COORDENADAS EN "Z"

Dim lsne() As Double

'CREA LISTA DE LOS NUMEROS DE ELEMENTOS

Dim lsi() As Double

'CREA LISTA DE PUNTOS INICIALES DE ELEMENTOS

Dim lsj() As Double

'CREA LISTA DE PUNTOS FINALES DE ELEMENTOS

Dim lstip() As String

'CREA LISTA DE TIPOS DE ELEMENTOS

Dim lse() As Double

'CREA LISTA DE MODULOS DE ELASTICIDADES

Dim lsg() As Double

'CREA LISTA DE MODULOS DE CORTE

Dim lsu() As Double

'CREA LISTA DE COEFICIENTES DE POISSON

Dim lsb() As Double

'CREA LISTA DE BASES DE LOS ELEMENTO

Dim lsh() As Double

'CREA LISTA DE PERALTES DE LOS ELEMENTOS

Dim lsd() As Double

'CREA LISTA DE DIAMETROS DE ELEMENTOS

Dim lsarea() As Double

'CREA LISTA DE AREAS DE ELEMENTOS

Dim lin2() As Double

'CREA LISTA DE INERCIAS AL EJE 2

Dim lin3() As Double

'CREA LISTA DE INERCIAS AL EJE 3

Dim linj() As Double

'CREA LISTA DE INERCIAS POLARES

Dim lser() As Double

'CREA LISTA DE NUMEROS DE ELEMENTOS A ROTAR

Dim lsa() As Double

'CREA LISTA DE ANGULOS A ROTAR

Dim lmod() As Double

'CREA LISTA DE LONGITUDES

Dim u1x() As Double

'CREA LISTA DE COORD EN X DE U1

Dim u1y() As Double

'CREA LISTA DE COORD EN Y DE U1

Dim u1z() As Double

'CREA LISTA DE COORD EN Z DE U1

Dim u2x() As Double

'CREA LISTA DE COORD EN X DE U2

Dim u2y() As Double

'CREA LISTA DE COORD EN Y DE U2

Dim u2z() As Double

'CREA LISTA DE COORD EN Z DE U2

Dim u3x() As Double

'CREA LISTA DE COORD EN X DE U3

Dim u3y() As Double

'CREA LISTA DE COORD EN Y DE U3

Dim u3z() As Double

'CREA LISTA DE COORD EN Z DE U3

Dim aux() As Double

'CREA LISTA AUXILIAR

Dim auxx1() As Double

'CREA MATRIZ AUXILIAR 1

Dim auxx2() As Double

'CREA MATRIZ AUXILIAR 2

Dim auxx3() As Double

'CREA MATRIZ AUXILIAR A Koo

Dim auxx4() As Double

'CREA MATRIZ AUXILIAR PARA OBTENER EL Do

Dim auxx5() As Double

'CREA MATRIZ AUXILIAR PARA Kxo.Do1

Dim auxx6() As Double

'CREA MATRIZ AUXILIAR PARA Kxx.Dx

Dim mr() As Double

'CREA MATRIZ REORDENADA

Dim Qot() As Double
'CREA LA MATRIZ DE CARGAS Qot EN SCG PARA LAS
CARGAS EN TODOS LOS NUDOS (LIBRES Y APOYOS)
Dim qe(1 To 12) As Double 'VECTOR DE CARGAS EQUIVALENTES
Dim Qoe(1 To 12) As Double 'MATRIZ EN SGC PARA CARGAS EQUIVALENTES
Dim Qnudo() As Double

'MATRIZ DE CARGAS SCG EN LOS NUDOS LIBRES

Dim Koo() As Double

'MATRIZ DE RIGIDEZ Koo

Dim Kox() As Double

'MATRIZ DE RIGIDEZ Kox

Dim Kxo() As Double

'MATRIZ DE RIGIDEZ Kxo

Dim Kxx() As Double

'MATRIZ DE RIGIDEZ Kxx

Dim inv() As Double

'MATRIZ INVERSA DE LA MATRIZ Koo

Dim Do1() As Double

'DESPLAZAMIENTOS DE LOS NUDOS LIBRES

Dim Dx() As Double

'MATRIZ DE DESPLAZAMIENTOS CONOCIDOS

Dim Qx() As Double
NUDOS

'MATRIZ DE CARGAS DESCONOCIDAS - REACCIONES

Dim Qo() As Double

'MATRIZ DE CARGAS EN LOS NUDOS LIBRES EN EL SCG

Dim QxA() As Double

'MATRIZ DE CARGAS EUIVALENTES EN LOS APOYOS

Dim Qxfinal() As Double

'MATRIZ DE REACCIONES FINALES EN LOS APOYOS

Dim lapoy() As Double

'MATRIZ DE APOYOS

Dim di(1 To 12) As Double 'MATRIZ DE DESPLAZAMIENTOS EN LOS ELEMENTOS i
Dim dia(1 To 12) As Double 'MATRIZ AUXILIAR A di
Dim qoi(1 To 12) As Double 'MATRIZ DE CARGAS EN SCL, PARA GRAFICAR
Dim qfinal(1 To 12) As Double 'MATRIZ DE CARGAS FINALES EN SCL PARA
GRAFICAR
Dim qf(1 To 12) As Double 'MATRIZ DE FIJACIÓN
Dim co As Double

'CONTADOR PARA NUM DE COOR DESCONOCIDAS

Dim cx As Double

'CONTADOR PARA NUM DE COOR CONOCIDAS

Dim nx As Double

'CONTADOR PARA TOTAL DE COORDANAS

Dim apoyo() As Double

'MATRIZ COLUMNA DE LOS DATOS DE LOS APOYOS

Dim ncon() As Double

'MATRIZ DE SOLO COOR CONOCIDOS

Dim ndes() As Double

'MATRIZ DE SOLO COOR DESCONOCIDOS

Dim clibres() As Double

'MATRIZ DE COORDENADAS LIBRES

Dim Qotc() As Double

'MATRIZ COLUMNA DE Qot

Dim pb1 As Double
Dim pb2 As Double
Dim MT() As Double

'MATRIZ TOTAL DE LOS DESPLAZAMIENTOS EN SCG

Private Sub AGREGARABAJOD_Click()
Dim a
If lelem.ListIndex <> -1 Then

If Len(Trim(txtelem)) > 0 Then
a = lelem.ListIndex + 1
lelem.AddItem txtelem.Value, a

lang.AddItem txtang.Value, a
If optv.Value = True Then
ltipo.AddItem optv.Caption, a
lt.AddItem 1, a
Else
If optc.Value = True Then
ltipo.AddItem optc.Caption, a
lt.AddItem 2, a
End If
End If
le.AddItem txte.Value, a
lg.AddItem txtg.Value, a
lu.AddItem txtu.Value, a
lb.AddItem txtb.Value, a
lh.AddItem txth.Value, a
ld.AddItem txtd.Value, a
txte.SetFocus
CommandButton2.Enabled = False
cb2.Value = False
txtelem = ""
txtang = "0"
txtelem.SetFocus

End If
Else
MsgBox ("DEBES ELIGIR UN RANGO DE FILA")
End If
End Sub

Private Sub AGREGARARRIBAD_Click()
Dim a
If lelem.ListIndex <> -1 Then

If Len(Trim(txtelem)) > 0 Then
a = lelem.ListIndex
lelem.AddItem txtelem.Value, a
lang.AddItem txtang.Value, a
If optv.Value = True Then
ltipo.AddItem optv.Caption, a
lt.AddItem 1, a
Else
If optc.Value = True Then
ltipo.AddItem optc.Caption, a
lt.AddItem 2, a
End If
End If

le.AddItem txte.Value, a
lg.AddItem txtg.Value, a
lu.AddItem txtu.Value, a
lb.AddItem txtb.Value, a
lh.AddItem txth.Value, a
ld.AddItem txtd.Value, a
txte.SetFocus
CommandButton2.Enabled = False
cb2.Value = False
txtelem = ""

txtang = "0"
txtelem.SetFocus

End If
Else
MsgBox ("DEBES ELIGIR UN RANGO DE FILA")
End If
End Sub

Private Sub btmat_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
btvec.Enabled = True
End Sub

Private Sub btmatglobal_Click()

End Sub

Private Sub bttran_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
CommandButton8.Enabled = True
End Sub

Private Sub btvec_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
bttran.Enabled = True
End Sub

Private Sub CheckBox1_Click()
If CheckBox1.Value = True Then
CheckBox2.Value = False
txtu.Text = "0"

txtu.Enabled = False
Else
txtu.Enabled = True
txtu.Text = ""
End If
End Sub

Private Sub CheckBox2_Click()
If CheckBox2.Value = True Then
txtg.Text = "0"
txtg.Enabled = False
Else
txtg.Enabled = True
txtg.Text = ""
End If
End Sub

Private Sub Cmbtrada_Click()

End Sub

Private Sub CMDANALIZAR_Click()
btmat_Click
btvec_Click
bttran_Click
CommandButton8_Click
CommandButton10_Click
CommandButton13_Click
CommandButton14_Click

nnuudd = Hoja6.Cells(4, 7)
nneell = Hoja6.Cells(4, 8)
r = nnuudd + 6 * nneell

maxaxii = Abs(Hoja1.Cells(r + 18 + 15 * (2 - 2) + 1, 97))
maxaxij = Abs(Hoja1.Cells(r + 18 + 15 * (2 - 2) + 7, 97))

maxc22i = Abs(Hoja1.Cells(r + 18 + 15 * (2 - 2) + 2, 97))
maxc22j = Abs(Hoja1.Cells(r + 18 + 15 * (2 - 2) + 8, 97))

maxc33i = Abs(Hoja1.Cells(r + 18 + 15 * (2 - 2) + 3, 97))
maxc33j = Abs(Hoja1.Cells(r + 18 + 15 * (2 - 2) + 9, 97))

maxtori = Abs(Hoja1.Cells(r + 18 + 15 * (2 - 2) + 4, 97))
maxtorj = Abs(Hoja1.Cells(r + 18 + 15 * (2 - 2) + 10, 97))

maxm22i = Abs(Hoja1.Cells(r + 18 + 15 * (2 - 2) + 5, 97))
maxm22j = Abs(Hoja1.Cells(r + 18 + 15 * (2 - 2) + 11, 97))

maxm33i = Abs(Hoja1.Cells(r + 18 + 15 * (2 - 2) + 6, 97))
maxm33j = Abs(Hoja1.Cells(r + 18 + 15 * (2 - 2) + 12, 97))

minlon = Abs(Hoja1.Cells(nnuudd + 13 + 1, 21))

For jp = 1 To nneell

maxaxii = Application.Max(maxaxii, Abs(Hoja1.Cells(r + 18 + 15 * (jp - 1) + 1, 97)))
maxaxij = Application.Max(maxaxij, Abs(Hoja1.Cells(r + 18 + 15 * (jp - 1) + 7, 97)))

maxc22i = Application.Max(maxc22i, Abs(Hoja1.Cells(r + 18 + 15 * (jp - 1) + 2, 97)))
maxc22j = Application.Max(maxc22j, Abs(Hoja1.Cells(r + 18 + 15 * (jp - 1) + 8, 97)))

maxc33i = Application.Max(maxc33i, Abs(Hoja1.Cells(r + 18 + 15 * (jp - 1) + 3, 97)))
maxc33j = Application.Max(maxc33j, Abs(Hoja1.Cells(r + 18 + 15 * (jp - 1) + 9, 97)))

maxtori = Application.Max(maxtori, Abs(Hoja1.Cells(r + 18 + 15 * (jp - 1) + 4, 97)))
maxtorj = Application.Max(maxtorj, Abs(Hoja1.Cells(r + 18 + 15 * (jp - 1) + 10, 97)))

maxm22i = Application.Max(maxm22i, Abs(Hoja1.Cells(r + 18 + 15 * (jp - 1) + 5, 97)))
maxm22j = Application.Max(maxm22j, Abs(Hoja1.Cells(r + 18 + 15 * (jp - 1) + 11,
97)))

maxm33i = Application.Max(maxm33i, Abs(Hoja1.Cells(r + 18 + 15 * (jp - 1) + 6, 97)))
maxm33j = Application.Max(maxm33j, Abs(Hoja1.Cells(r + 18 + 15 * (jp - 1) + 12,
97)))

minlon = Application.Min(minlon, Abs(Hoja1.Cells(nnuudd + 13 + jp, 21)))
Next
Hoja8.Cells(6, 14) = minlon
Label83.Caption = 2 * Application.Max(maxm33i, maxm33j) / minlon
TextBox7.Value = Label83.Caption
Hoja8.Cells(6, 7) = Label83.Caption
Label83.Caption = 2 * Application.Max(maxc22i, maxc22j) / minlon
TextBox8.Value = Label83.Caption
Hoja8.Cells(6, 8) = Label83.Caption

Label83.Caption = 2 * Application.Max(maxaxii, maxaxij) / minlon
TextBox9.Value = Label83.Caption
Hoja8.Cells(6, 9) = Label83.Caption
Label83.Caption = 2 * Application.Max(maxm22i, maxm22j) / minlon
TextBox10.Value = Label83.Caption
Hoja8.Cells(6, 10) = Label83.Caption
Label83.Caption = 2 * Application.Max(maxc33i, maxc33j) / minlon
TextBox11.Value = Label83.Caption
Hoja8.Cells(6, 11) = Label83.Caption
Label83.Caption = 2 * Application.Max(maxtori, maxtorj) / minlon
TextBox12.Value = Label83.Caption
Hoja8.Cells(6, 12) = Label83.Caption

TextBox13.Value = 30
TextBox15.Value = 2
Label83.Caption = 0.1
TextBox14.Value = Label83.Caption

Label83.Caption = ""
End Sub

Private Sub CommandButton10_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
CommandButton11.Enabled = True
End Sub

Private Sub CommandButton11_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
CommandButton13.Enabled = True
End Sub

Private Sub CommandButton15_Click()
Dim a
If lelem.ListIndex <> -1 Then
a = ltipo.ListIndex
ltipo.RemoveItem a
lelem.RemoveItem a
le.RemoveItem a
lg.RemoveItem a
lu.RemoveItem a
lb.RemoveItem a
lh.RemoveItem a
ld.RemoveItem a
lang.RemoveItem a
lt.RemoveItem a
txte.SetFocus
CommandButton2.Enabled = False
cb2.Value = False
Else
MsgBox ("DEBES ELIGIR UN RANGO DE FILA")
End If
End Sub

Private Sub AUMENTAR_Click()

lx.AddItem 0, lx.ListIndex
ly.AddItem 0, ly.ListIndex

lz.AddItem 0, lz.ListIndex
txtx.SetFocus
txtx = ""
txty = ""
txtz = ""
txtx.SetFocus
CommandButton1.Enabled = False
cb1.Value = False
End Sub

Private Sub ELIMINAR_Click()
lnum.RemoveItem lnum.ListIndex
lx.RemoveItem lx.ListIndex
ly.RemoveItem ly.ListIndex
lz.RemoveItem lz.ListIndex
txtx.SetFocus
txtx = ""
txty = ""
txtz = ""
txtx.SetFocus
CommandButton1.Enabled = False
cb1.Value = False
End Sub

Private Sub AGREGARABAJO_Click()
Dim a, b
If lx.ListIndex <> -1 Then

a = txtnum.Value
b = lnum.ListIndex + 1
lnum.AddItem a, b
lx.AddItem txtx.Value, b
ly.AddItem txty.Value, b
lz.AddItem txtz.Value, b

txtx.SetFocus
txtx = ""
txty = ""
txtz = ""
txtx.SetFocus
CommandButton1.Enabled = False
cb1.Value = False
Else
MsgBox ("DEBES SELECCIONAR LA MISMA FILA DE NUM , X, Y, Z")
End If

End Sub

Private Sub AGREGARABAJOE_Click()
Dim a, b
If lnu.ListIndex <> -1 Then
a = txtnu.Value
b = lnu.ListIndex + 1
lnu.AddItem a, b
li.AddItem txti.Value, b
lj.AddItem txtj.Value, b

txtnu.SetFocus
txti = ""
txtj = ""
CommandButton3.Enabled = False
cb3.Value = False
Else
MsgBox ("DEBES SELECCIONAR LA MISMA FILA DE NUM NUM ,i ,j")
End If
End Sub

Private Sub AGREGARARRIBAE_Click()
Dim a, b
If lnu.ListIndex <> -1 Then
a = txtnu.Value
b = lnu.ListIndex
lnu.AddItem a, b
li.AddItem txti.Value, b
lj.AddItem txtj.Value, b

txtnu.SetFocus
txti = ""
txtj = ""
CommandButton3.Enabled = False
cb3.Value = False
Else
MsgBox ("DEBES SELECCIONAR LA MISMA FILA DE NUM NUM, i, j")
End If
End Sub

Private Sub AGREGARFILA_Click()
Dim a, b
If lx.ListIndex <> -1 Then
a = txtnum.Value
b = lnum.ListIndex
lnum.AddItem a, b
lx.AddItem txtx.Value, b
ly.AddItem txty.Value, b
lz.AddItem txtz.Value, b

txtx.SetFocus
txtx = ""
txty = ""
txtz = ""
txtx.SetFocus
CommandButton1.Enabled = False
cb1.Value = False

Else
MsgBox ("DEBES SELECCIONAR LA MISMA FILA DE NUM , X, Y, Z")
End If

End Sub

Private Sub CommandButton16_Click()
LIMPIA

End Sub

Private Sub CommandButton17_Click()
On Error GoTo NOarchivo:
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset

'Creamos el objeto Connection.
'Creamos el objeto Recordset.

'Abrimos la base de datos "agenda2000.mdb".
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data
Source=C:\Users\carsa\Desktop\ANALISIS2\FORMATO\" & TextBox1.Text & ".mdb"
rs.Source = "COORDENADAS" 'Especificamos la fuente de Hoja6. En este caso la tabla
"contactos".
rs.CursorType = adOpenKeyset 'Definimos el tipo de cursor.
rs.LockType = adLockOptimistic 'Definimos el tipo de bloqueo.
rs.Open "select * from COORDENADAS", cn 'Abrimos el Recordset y lo llenamos con una
consulta SQL.
rs.MoveFirst 'Nos posicionamos en el primer registro del Recordset.
lnum.Clear
lx.Clear
ly.Clear
lz.Clear
Do Until rs.EOF 'Repite hasta que se lea todo el Recordset.
lnum.AddItem rs.Fields("NUDO")
lx.AddItem rs.Fields("X")
ly.AddItem rs.Fields("Y")
lz.AddItem rs.Fields("Z")
rs.MoveNext 'Nos movemos al siguiente registro.
Loop
MELO = 1
If MELO <> 1 Then
NOarchivo:

MsgBox ("LA BASE DE DATOS NO EXISTE")
End If

End Sub

Private Sub CommandButton18_Click()
On Error GoTo NOarchivo:
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset

'Creamos el objeto Connection.
'Creamos el objeto Recordset.

'Abrimos la base de datos "agenda2000.mdb".
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data
Source=C:\Users\carsa\Desktop\ANALISIS2\FORMATO\" & TextBox1.Text & ".mdb"
rs.Source = "IDENTIFICA" 'Especificamos la fuente de Hoja6. En este caso la tabla
"contactos".
rs.CursorType = adOpenKeyset 'Definimos el tipo de cursor.
rs.LockType = adLockOptimistic 'Definimos el tipo de bloqueo.
rs.Open "select * from IDENTIFICA", cn 'Abrimos el Recordset y lo llenamos con una consulta
SQL.
rs.MoveFirst 'Nos posicionamos en el primer registro del Recordset.
lnu.Clear
li.Clear
lj.Clear

Do Until rs.EOF 'Repite hasta que se lea todo el Recordset.
lnu.AddItem rs.Fields("ELEMENTO")
li.AddItem rs.Fields("NUDO i")
lj.AddItem rs.Fields("NUDO j")

rs.MoveNext 'Nos movemos al siguiente registro.
Loop

MELO = 1
If MELO <> 1 Then
NOarchivo:
MsgBox ("LA BASE DE DATOS NO EXISTE")
End If
End Sub

Private Sub CommandButton19_Click()
On Error GoTo NOarchivo:
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset

'Creamos el objeto Connection.
'Creamos el objeto Recordset.

'Abrimos la base de datos "agenda2000.mdb".
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data
Source=C:\Users\carsa\Desktop\ANALISIS2\FORMATO\" & TextBox1.Text & ".mdb"
rs.Source = "PROPIEDADES" 'Especificamos la fuente de Hoja6. En este caso la tabla
"contactos".
rs.CursorType = adOpenKeyset 'Definimos el tipo de cursor.
rs.LockType = adLockOptimistic 'Definimos el tipo de bloqueo.
rs.Open "select * from PROPIEDADES", cn 'Abrimos el Recordset y lo llenamos con una
consulta SQL.
rs.MoveFirst 'Nos posicionamos en el primer registro del Recordset.
lelem.Clear
le.Clear
lg.Clear
lu.Clear
lb.Clear
lh.Clear
ld.Clear
lang.Clear
ltipo.Clear

lt.Clear
Do Until rs.EOF 'Repite hasta que se lea todo el Recordset.

lelem.AddItem rs.Fields("ELEMENTO")
le.AddItem rs.Fields("E")
lg.AddItem rs.Fields("G")
lu.AddItem rs.Fields("U")
lb.AddItem rs.Fields("b")
lh.AddItem rs.Fields("h")
ld.AddItem rs.Fields("d")
lang.AddItem rs.Fields("ROTACION")
ltipo.AddItem rs.Fields("TIPO")
If rs.Fields("TIPO") = "COLUMNA" Then
lt.AddItem "2"
Else
lt.AddItem "1"
End If

rs.MoveNext 'Nos movemos al siguiente registro.
Loop
MELO = 1
If MELO <> 1 Then
NOarchivo:
MsgBox ("LA BASE DE DATOS NO EXISTE")
End If
End Sub

Private Sub CommandButton20_Click()
Frame5.Visible = False

Frame6.Visible = False
Frame7.Visible = False
Frame9.Visible = False
Frame1.Top = 4
Frame2.Top = 4
Frame4.Top = 4
Frame1.Height = 520
Frame2.Height = 520
Frame4.Height = 520
lnum.Height = 450
lx.Height = 450
ly.Height = 450
lz.Height = 450
lnu.Height = 450
li.Height = 450
lj.Height = 450
lelem.Height = 450
le.Height = 450
lg.Height = 450
lu.Height = 450
lb.Height = 450
lh.Height = 450
ld.Height = 450
lang.Height = 450
ltipo.Height = 450
lt.Height = 450
Frame12.Visible = False
Image2.BackColor = &H8000000D

End Sub

Private Sub CommandButton21_Click()
Frame5.Visible = True
Frame6.Visible = True
Frame7.Visible = True
Frame9.Visible = True
Frame1.Top = 186
Frame2.Top = 186
Frame4.Top = 186
Frame1.Height = 520
Frame2.Height = 520
Frame4.Height = 520
lnum.Height = 450
lx.Height = 450
ly.Height = 450
lz.Height = 450
lnu.Height = 450
li.Height = 450
lj.Height = 450
lelem.Height = 450
le.Height = 450
lg.Height = 450
lu.Height = 450
lb.Height = 450
lh.Height = 450
ld.Height = 450
lang.Height = 450
ltipo.Height = 450

lt.Height = 450
End Sub

Private Sub CommandButton22_Click()
For i = 1 To Hoja6.Cells(4, 7)
Label48.Caption = Hoja6.Cells(8 + i, 2)
lnum.AddItem Label48

Label48.Caption = Hoja6.Cells(8 + i, 3)
lx.AddItem Label48

Label48.Caption = Hoja6.Cells(8 + i, 4)
ly.AddItem Label48

Label48.Caption = Hoja6.Cells(8 + i, 5)
lz.AddItem Label48

Next
For i = 1 To Hoja6.Cells(4, 8)
Label48.Caption = Hoja6.Cells(8 + i, 7)
lnu.AddItem Label48

Label48.Caption = Hoja6.Cells(8 + i, 8)
li.AddItem Label48

Label48.Caption = Hoja6.Cells(8 + i, 9)
lj.AddItem Label48

Label48.Caption = Hoja6.Cells(8 + i, 11)

lelem.AddItem Label48

Label48.Caption = Hoja6.Cells(8 + i, 12)
le.AddItem Label48

Label48.Caption = Hoja6.Cells(8 + i, 13)
lg.AddItem Label48.Caption

Label48.Caption = Hoja6.Cells(8 + i, 14)
lu.AddItem Label48

Label48.Caption = Hoja6.Cells(8 + i, 15)
lb.AddItem Label48.Caption

Label48.Caption = Hoja6.Cells(8 + i, 16)
lh.AddItem Label48.Caption

Label48.Caption = Hoja6.Cells(8 + i, 17)
ld.AddItem Label48.Caption

Label48.Caption = Hoja6.Cells(8 + i, 18)
lhp.AddItem Label48

Label48.Caption = Hoja6.Cells(8 + i, 19)
lbp.AddItem Label48.Caption

Label48.Caption = Hoja6.Cells(8 + i, 20)
ltf.AddItem Label48.Caption

Label48.Caption = Hoja6.Cells(8 + i, 21)
ltw.AddItem Label48.Caption

Label48.Caption = Hoja6.Cells(8 + i, 22)
lseccion.AddItem Label48.Caption

Label48.Caption = Hoja6.Cells(8 + i, 23)
ltipodeseccion.AddItem Label48.Caption

Label48.Caption = Hoja6.Cells(8 + i, 24)
lang.AddItem Label48.Caption

Label48.Caption = Hoja6.Cells(8 + i, 25)
ltipo.AddItem Label48.Caption

Label48.Caption = Hoja6.Cells(8 + i, 26)
lt.AddItem Label48.Caption
Next

UserForm2.lstdn.Clear
UserForm2.lstdx.Clear
UserForm2.lstdy.Clear
UserForm2.lstdz.Clear
UserForm2.lstgx.Clear
UserForm2.lstgy.Clear
UserForm2.lstgz.Clear

UserForm2.lstfn.Clear
UserForm2.lstfx.Clear
UserForm2.lstfy.Clear
UserForm2.lstfz.Clear
UserForm2.lstmx.Clear
UserForm2.lstmy.Clear
UserForm2.lstmz.Clear

' APOYOS Y NUDOS

For i = 1 To Hoja6.Cells(4, 9)
Label48.Caption = Hoja6.Cells(8 + i, 28)
UserForm2.lstdn.AddItem Label48

Label48.Caption = Hoja6.Cells(8 + i, 29)
UserForm2.lstdx.AddItem Label48

Label48.Caption = Hoja6.Cells(8 + i, 30)
UserForm2.lstdy.AddItem Label48

Label48.Caption = Hoja6.Cells(8 + i, 31)
UserForm2.lstdz.AddItem Label48

Label48.Caption = Hoja6.Cells(8 + i, 32)
UserForm2.lstgx.AddItem Label48

Label48.Caption = Hoja6.Cells(8 + i, 33)
UserForm2.lstgy.AddItem Label48

Label48.Caption = Hoja6.Cells(8 + i, 34)
UserForm2.lstgz.AddItem Label48
Next
For i = 1 To Hoja6.Cells(4, 10)
Label48.Caption = Hoja6.Cells(8 + i, 36)
UserForm2.lstfn.AddItem Label48

Label48.Caption = Hoja6.Cells(8 + i, 37)
UserForm2.lstfx.AddItem Label48

Label48.Caption = Hoja6.Cells(8 + i, 38)
UserForm2.lstfy.AddItem Label48

Label48.Caption = Hoja6.Cells(8 + i, 39)
UserForm2.lstfz.AddItem Label48

Label48.Caption = Hoja6.Cells(8 + i, 40)
UserForm2.lstmx.AddItem Label48

Label48.Caption = Hoja6.Cells(8 + i, 41)
UserForm2.lstmy.AddItem Label48

Label48.Caption = Hoja6.Cells(8 + i, 42)

UserForm2.lstmz.AddItem Label48
Next

UserForm4.lstel.Clear
UserForm4.lstq1.Clear
UserForm4.lstq2.Clear
UserForm4.lstq3.Clear
UserForm4.lstq4.Clear
UserForm4.lstq5.Clear
UserForm4.lstq6.Clear

UserForm4.lstq7.Clear
UserForm4.lstq8.Clear
UserForm4.lstq9.Clear
UserForm4.lstq10.Clear
UserForm4.lstq11.Clear
UserForm4.lstq12.Clear

' ELMEENTOS

For i = 1 To Hoja6.Cells(4, 11)
Label48.Caption = Hoja6.Cells(8 + i, 55)
UserForm4.lstel.AddItem Label48
Label48.Caption = Hoja6.Cells(8 + i, 56)
UserForm4.lstq1.AddItem Label48
Label48.Caption = Hoja6.Cells(8 + i, 57)

UserForm4.lstq2.AddItem Label48
Label48.Caption = Hoja6.Cells(8 + i, 58)
UserForm4.lstq3.AddItem Label48
Label48.Caption = Hoja6.Cells(8 + i, 59)
UserForm4.lstq4.AddItem Label48
Label48.Caption = Hoja6.Cells(8 + i, 60)
UserForm4.lstq5.AddItem Label48
Label48.Caption = Hoja6.Cells(8 + i, 61)
UserForm4.lstq6.AddItem Label48

Label48.Caption = Hoja6.Cells(8 + i, 62)
UserForm4.lstq7.AddItem Label48
Label48.Caption = Hoja6.Cells(8 + i, 63)
UserForm4.lstq8.AddItem Label48
Label48.Caption = Hoja6.Cells(8 + i, 64)
UserForm4.lstq9.AddItem Label48
Label48.Caption = Hoja6.Cells(8 + i, 65)
UserForm4.lstq10.AddItem Label48
Label48.Caption = Hoja6.Cells(8 + i, 66)
UserForm4.lstq11.AddItem Label48
Label48.Caption = Hoja6.Cells(8 + i, 67)
UserForm4.lstq12.AddItem Label48
Next

End Sub

Private Sub CommandButton25_Click()

'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXXXXX
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXXXXX
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX------------------------------------------------------XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX------BOTON PARA
GRAFICAR DIAGRAMAS EN EL AUTOCAD-----XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX------BOTON PARA
GRAFICAR DIAGRAMAS EN EL AUTOCAD-----XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX------------------------------------------------------XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXXXXX
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXXXXX

'RECIBIR DATOS

nnuudd = Hoja6.Cells(4, 7)
nneell = Hoja6.Cells(4, 8)
r = nnuudd + 6 * nneell

For jp = 1 To nneell
'ENVIAR COODENADAS DE CADA ELEMENTO
Hoja8.Cells(10 + 22 * (jp - 1) + 1, 3) = Hoja1.Cells(7 + Hoja1.Cells(nnuudd + 13 + jp,
3), 5)
Hoja8.Cells(10 + 22 * (jp - 1) + 2, 3) = Hoja1.Cells(7 + Hoja1.Cells(nnuudd + 13 + jp,
3), 6)
Hoja8.Cells(10 + 22 * (jp - 1) + 3, 3) = Hoja1.Cells(7 + Hoja1.Cells(nnuudd + 13 + jp,
4), 5)
Hoja8.Cells(10 + 22 * (jp - 1) + 4, 3) = Hoja1.Cells(7 + Hoja1.Cells(nnuudd + 13 + jp,
4), 6)
Hoja8.Cells(10 + 22 * (jp - 1) + 5, 3) = Hoja1.Cells(7 + Hoja1.Cells(nnuudd + 13 + jp,
3), 7)
Hoja8.Cells(10 + 22 * (jp - 1) + 6, 3) = Hoja1.Cells(7 + Hoja1.Cells(nnuudd + 13 + jp,
4), 7)
'ENVIAR VECTORES UNITARIO DE CADA ELEMENTO
Hoja8.Cells(10 + 22 * (jp - 1) + 1, 5) = Hoja1.Cells(6 + 3 * (jp - 1) + 1, 33)

Hoja8.Cells(10 + 22 * (jp - 1) + 2, 5) = Hoja1.Cells(6 + 3 * (jp - 1) + 1, 34)
Hoja8.Cells(10 + 22 * (jp - 1) + 3, 5) = Hoja1.Cells(6 + 3 * (jp - 1) + 2, 33)
Hoja8.Cells(10 + 22 * (jp - 1) + 4, 5) = Hoja1.Cells(6 + 3 * (jp - 1) + 2, 34)
Hoja8.Cells(10 + 22 * (jp - 1) + 5, 5) = Hoja1.Cells(6 + 3 * (jp - 1) + 1, 35)
Hoja8.Cells(10 + 22 * (jp - 1) + 6, 5) = Hoja1.Cells(6 + 3 * (jp - 1) + 2, 35)
Hoja8.Cells(10 + 22 * (jp - 1) + 7, 5) = Hoja1.Cells(6 + 3 * (jp - 1) + 3, 33)
Hoja8.Cells(10 + 22 * (jp - 1) + 8, 5) = Hoja1.Cells(6 + 3 * (jp - 1) + 3, 34)
Hoja8.Cells(10 + 22 * (jp - 1) + 9, 5) = Hoja1.Cells(6 + 3 * (jp - 1) + 3, 35)
'ENVIAR LOS Q FINALES DE CADA ELEMENTO
Hoja8.Cells(22 + 22 * (jp - 1) + 1, 3) = Hoja1.Cells(r + 18 + 15 * (jp - 1) + 1, 97)
Hoja8.Cells(22 + 22 * (jp - 1) + 2, 3) = Hoja1.Cells(r + 18 + 15 * (jp - 1) + 2, 97)
Hoja8.Cells(22 + 22 * (jp - 1) + 3, 3) = Hoja1.Cells(r + 18 + 15 * (jp - 1) + 6, 97)
Hoja8.Cells(22 + 22 * (jp - 1) + 4, 3) = Hoja1.Cells(r + 18 + 15 * (jp - 1) + 4, 97)
Hoja8.Cells(22 + 22 * (jp - 1) + 5, 3) = Hoja1.Cells(r + 18 + 15 * (jp - 1) + 3, 97)
Hoja8.Cells(22 + 22 * (jp - 1) + 6, 3) = Hoja1.Cells(r + 18 + 15 * (jp - 1) + 5, 97)
'ENVIAR LA LONGITUD DE CADA ELEMENTO
Hoja8.Cells(22 * (jp - 1) + 9 + 0, 5) = Hoja1.Cells(nnuudd + 13 + jp, 21)

sss = 0

'NUMERO DE CARGAS EN ELEMENTOS
For nc = 1 To Hoja6.Cells(4, 11)
'SI HAY CARGA EN CADA ELEMENTO, ENTONCES SE COLOCA LO
SIGUIENTE
If Hoja6.Cells(8 + nc, 55) = jp Then
sss = sss + 1
Hoja8.Cells(9 + 22 * (jp - 1), 10) = sss

Hoja8.Cells(11 + 22 * (jp - 1), 8 + 3 * (sss - 1)) = "CARGA NUMERO " & sss

Hoja8.Cells(12 + 22 * (jp - 1), 7 + 3 * (sss - 1)) = "TIP0"
Hoja8.Cells(12 + 22 * (jp - 1), 8 + 3 * (sss - 1)) = "DIST a"
Hoja8.Cells(12 + 22 * (jp - 1), 9 + 3 * (sss - 1)) = "P Q o M"

Hoja8.Cells(13 + 22 * (jp - 1), 7 + 3 * (sss - 1)) = Hoja6.Cells(8 + nc, 51)
Hoja8.Cells(13 + 22 * (jp - 1), 8 + 3 * (sss - 1)) = Hoja6.Cells(8 + nc, 52)
Hoja8.Cells(13 + 22 * (jp - 1), 9 + 3 * (sss - 1)) = Hoja6.Cells(8 + nc, 53)
End If
'SI NO HAY CARGA EN UN ELEMETO, ENTONCES SE COLOCA LO SIGUIENTE
If sss = 0 Then
Hoja8.Cells(9 + 22 * (jp - 1), 10) = 1

Hoja8.Cells(11 + 22 * (jp - 1), 8) = "CARGA NUMERO 1"
Hoja8.Cells(12 + 22 * (jp - 1), 7) = "TIP0"
Hoja8.Cells(12 + 22 * (jp - 1), 8) = "DIST a"
Hoja8.Cells(12 + 22 * (jp - 1), 9) = "P Q o M"

Hoja8.Cells(13 + 22 * (jp - 1), 7) = "No"
Hoja8.Cells(13 + 22 * (jp - 1), 8) = ""
Hoja8.Cells(13 + 22 * (jp - 1), 9) = ""
End If
Next

Next

'DATOS IMPORTANTES
'ELEMENTOS
Hoja8.Cells(5, 3) = "ELEMEN"
Hoja8.Cells(5, 4) = nneell

nelem = Hoja8.Cells(5, 4) 'NUMERO DE ELEMENTOS
'CORTES
Hoja8.Cells(6, 3) = "N CORTES"
Hoja8.Cells(6, 4) = TextBox13.Value
ncort = Hoja8.Cells(6, 4) 'NUMERO DE CORTES
'ESCALAS DIAGRAMAS
escalm33 = TextBox7.Value 'ESCALA MOMENTO 33
escalc22 = TextBox8.Value 'ESCALA CORTANTE 22
escalaxi = TextBox9.Value 'ESCALA AXIAL
escalm22 = TextBox10.Value 'ESCALA MOMENTO 22
escalc33 = TextBox11.Value 'ESCALA CORTANTE 33
escaltor = TextBox12.Value 'ESCALA TORSION
escaltext = TextBox14.Value 'ESCALA DEL TEXTO
numdecim = TextBox15.Value 'NUMERO DE DECIMALES
'SEPARACION ENTRE DIAGRAMAS
sep = 10

'GRAFICA LAS 3 ESTRUCTURAS PARA COLOCAR LOS DIAGRAMAS
For n3 = 1 To 6

'(SON 6 DIAGRAMAS)

For e = 1 To nelem
Set AcadDoc = GetObject(, "Autocad.Application").ActiveDocument
Set AcadDocEM = AcadDoc.ModelSpace
Pt1(1) = Hoja6.Cells(8 + Hoja6.Cells(8 + e, 8), 3) + 2 * (1 + n3) * sep: Pt1(2) =
Hoja6.Cells(8 + Hoja6.Cells(8 + e, 8), 4): Pt1(3) = Hoja6.Cells(8 + Hoja6.Cells(8 + e, 8), 5)
Pt2(1) = Hoja6.Cells(8 + Hoja6.Cells(8 + e, 9), 3) + 2 * (1 + n3) * sep: Pt2(2) =
Hoja6.Cells(8 + Hoja6.Cells(8 + e, 9), 4): Pt2(3) = Hoja6.Cells(8 + Hoja6.Cells(8 + e, 9), 5)
Set ObjLinea = AcadDocEM.AddLine(Pt1, Pt2)
ObjLinea.Color = 150
Next

Next

'ANALISIS PARA TODOS LOS ELEMENTOS
For n = 1 To nelem

'DATOS IMPORTANTES PARA CADA ELEMENTO
lelemto = Hoja8.Cells(22 * (n - 1) + 9 + 0, 5)
ncarg = Hoja8.Cells(22 * (n - 1) + 9 + 0, 10)
'TITULOS DE LAS TABLAS EN EL EXCEL
Hoja8.Cells(22 * (n - 1) + 9 + 0, 2) = "ELMENT"
Hoja8.Cells(22 * (n - 1) + 9 + 0, 3) = n
Hoja8.Cells(22 * (n - 1) + 9 + 0, 4) = "LONGIT"

Hoja8.Cells(22 * (n - 1) + 9 + 0, 8) = "NUMERO DE CARGAS"
Hoja8.Cells(22 * (n - 1) + 9 + 2, 2) = "COOR X1"
Hoja8.Cells(22 * (n - 1) + 9 + 3, 2) = "COOR Y1"
Hoja8.Cells(22 * (n - 1) + 9 + 4, 2) = "COOR X2"
Hoja8.Cells(22 * (n - 1) + 9 + 5, 2) = "COOR Y2"
Hoja8.Cells(22 * (n - 1) + 9 + 6, 2) = "COOR Z1"
Hoja8.Cells(22 * (n - 1) + 9 + 7, 2) = "COOR Z2"

Hoja8.Cells(22 * (n - 1) + 9 + 2, 4) = "VECT X1"
Hoja8.Cells(22 * (n - 1) + 9 + 3, 4) = "VECT Y1"
Hoja8.Cells(22 * (n - 1) + 9 + 4, 4) = "VECT X2"
Hoja8.Cells(22 * (n - 1) + 9 + 5, 4) = "VECT Y2"
Hoja8.Cells(22 * (n - 1) + 9 + 6, 4) = "VECT Z1"
Hoja8.Cells(22 * (n - 1) + 9 + 7, 4) = "VECT Z2"
Hoja8.Cells(22 * (n - 1) + 9 + 8, 4) = "VECT X3"
Hoja8.Cells(22 * (n - 1) + 9 + 9, 4) = "VECT Y3"

Hoja8.Cells(22 * (n - 1) + 9 + 10, 4) = "VECT Z3"

Hoja8.Cells(22 * (n - 1) + 19 + 2, 2) = "Corte"
Hoja8.Cells(22 * (n - 1) + 19 + 3, 2) = "lng"
Hoja8.Cells(22 * (n - 1) + 19 + 4, 2) = "FA"
Hoja8.Cells(22 * (n - 1) + 19 + 5, 2) = "FC22"
Hoja8.Cells(22 * (n - 1) + 19 + 6, 2) = "MF33"

Hoja8.Cells(22 * (n - 1) + 19 + 7, 2) = "MT"
Hoja8.Cells(22 * (n - 1) + 19 + 8, 2) = "FC33"
Hoja8.Cells(22 * (n - 1) + 19 + 9, 2) = "MF22"

For m = 0 To ncort + 1

'EL PRIMER CORTE ES EN 0

'CONDICIONES INICIALES PARA CADA CORTE
faat = 0
fcct = 0
mfct = 0
mttct = 0
f33ct = 0
m22ct = 0

For nc = 1 To Hoja8.Cells(22 * (n - 1) + 9 + 0, 10)

'DATOS NECESARIOS
pii = 0
pff = m * lelemto / (ncort + 1)
lng = pff - pii

'PUNTO INICIAL
'PUNTO FINAL
'LONGITUD

fa = Hoja8.Cells(22 * (n - 1) + 19 + 4, 3)
ELEMENTO

'FUERA AXIAL - CARGA LOCAL DEL

fc = Hoja8.Cells(22 * (n - 1) + 19 + 5, 3)
DEL ELEMENTO

'FUERZA CORTANTE - CARGA LOCAL

mf = Hoja8.Cells(22 * (n - 1) + 19 + 6, 3)
LOCAL DEL ELEMENTO

'MOMENTO FLECTOR - CARGA

mtt = Hoja8.Cells(22 * (n - 1) + 19 + 7, 3)
f33 = Hoja8.Cells(22 * (n - 1) + 19 + 8, 3)
m22 = Hoja8.Cells(22 * (n - 1) + 19 + 9, 3)

'BORRAR DATOS ANTERIORES DE MF FC FA
Hoja8.Cells(22 * (n - 1) + 19 + 6, 3 + m) = ""

'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'X----------SIN CARGA EN EL ELEMENTO-----------X
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

If Hoja8.Cells(13 + 22 * (n - 1), 7 + 3 * (nc - 1)) = "No" Then
'DATOS UTILIZADOS PARA ESTE TIPO DE CARGA
q=0
'LONGITUDES DESDE EL INICIO HASTA EL CORTE
Hoja8.Cells(22 * (n - 1) + 19 + 3, 3 + m) = lng
'MOMENTOS Y FUERZAS QUE SE RESTAN
fac = 0
fcc = 0
mfc = 0
mttc = 0
f33c = 0
m22c = 0

End If

'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'X---------CARGA DISTRIBUIDA - EJE 1-----------X
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

If Hoja8.Cells(13 + 22 * (n - 1), 7 + 3 * (nc - 1)) = "RECT1" Then
'DATOS UTILIZADOS PARA ESTE TIPO DE CARGA
q = Hoja8.Cells(13 + 22 * (n - 1), 9 + 3 * (nc - 1))
'LONGITUDES DESDE EL INICIO HASTA EL CORTE
Hoja8.Cells(22 * (n - 1) + 19 + 3, 3 + m) = lng
'MOMENTOS Y FUERZAS QUE SE RESTAN
fac = lng * q
fcc = 0
mfc = 0
mttc = 0
f33c = 0
m22c = 0

End If

'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'X---------CARGA DISTRIBUIDA - EJE 2-----------X
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

If Hoja8.Cells(13 + 22 * (n - 1), 7 + 3 * (nc - 1)) = "RECT2" Then
'DATOS UTILIZADOS PARA ESTE TIPO DE CARGA
q = -Hoja8.Cells(13 + 22 * (n - 1), 9 + 3 * (nc - 1))
'LONGITUDES DESDE EL INICIO HASTA EL CORTE

Hoja8.Cells(22 * (n - 1) + 19 + 3, 3 + m) = lng
'MOMENTOS Y FUERZAS QUE SE RESTAN
fac = 0
fcc = lng * q
mfc = q * lng * lng / 2
mttc = 0
f33c = 0
m22c = 0

End If

'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'X---------CARGA DISTRIBUIDA - EJE 3-----------X
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

If Hoja8.Cells(13 + 22 * (n - 1), 7 + 3 * (nc - 1)) = "RECT3" Then
'DATOS UTILIZADOS PARA ESTE TIPO DE CARGA
q = -Hoja8.Cells(13 + 22 * (n - 1), 9 + 3 * (nc - 1))
'LONGITUDES DESDE EL INICIO HASTA EL CORTE
Hoja8.Cells(22 * (n - 1) + 19 + 3, 3 + m) = lng
'MOMENTOS Y FUERZAS QUE SE RESTAN
fac = 0
fcc = 0
mfc = 0
mttc = 0
f33c = lng * q
m22c = q * lng * lng / 2

End If

'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'X---------MOMENTO DISTRIBUIDO - EJE 1---------X
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

If Hoja8.Cells(13 + 22 * (n - 1), 7 + 3 * (nc - 1)) = "MOD1" Then
'DATOS UTILIZADOS PARA ESTE TIPO DE CARGA
q = Hoja8.Cells(13 + 22 * (n - 1), 9 + 3 * (nc - 1))
'LONGITUDES DESDE EL INICIO HASTA EL CORTE
Hoja8.Cells(22 * (n - 1) + 19 + 3, 3 + m) = lng
'MOMENTOS Y FUERZAS QUE SE RESTAN
fac = 0
fcc = 0
mfc = 0
mttc = -q * lng
f33c = 0
m22c = 0

End If

'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'X---------MOMENTO DISTRIBUIDO - EJE 2---------X
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

If Hoja8.Cells(13 + 22 * (n - 1), 7 + 3 * (nc - 1)) = "MOD2" Then
'DATOS UTILIZADOS PARA ESTE TIPO DE CARGA
q = -Hoja8.Cells(13 + 22 * (n - 1), 9 + 3 * (nc - 1))
'LONGITUDES DESDE EL INICIO HASTA EL CORTE
Hoja8.Cells(22 * (n - 1) + 19 + 3, 3 + m) = lng

'MOMENTOS Y FUERZAS QUE SE RESTAN
fac = 0
fcc = 0
mfc = 0
mttc = 0
f33c = 0
m22c = -q * lng

End If

'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'X---------MOMENTO DISTRIBUIDO - EJE 3---------X
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

If Hoja8.Cells(13 + 22 * (n - 1), 7 + 3 * (nc - 1)) = "MOD3" Then
'DATOS UTILIZADOS PARA ESTE TIPO DE CARGA
q = -Hoja8.Cells(13 + 22 * (n - 1), 9 + 3 * (nc - 1))
'LONGITUDES DESDE EL INICIO HASTA EL CORTE
Hoja8.Cells(22 * (n - 1) + 19 + 3, 3 + m) = lng
'MOMENTOS Y FUERZAS QUE SE RESTAN
fac = 0
fcc = 0
mfc = -q * lng
mttc = 0
f33c = 0
m22c = 0

End If

'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'X------------CARGA PUNTUAL - EJE 1------------X
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

If Hoja8.Cells(13 + 22 * (n - 1), 7 + 3 * (nc - 1)) = "FUPU1" Then
'DATOS UTILIZADOS PARA ESTE TIPO DE CARGA
q = Hoja8.Cells(13 + 22 * (n - 1), 9 + 3 * (nc - 1))
aa = Hoja8.Cells(13 + 22 * (n - 1), 8 + 3 * (nc - 1))
'LONGITUDES DESDE EL INICIO HASTA EL CORTE
Hoja8.Cells(22 * (n - 1) + 19 + 3, 3 + m) = lng
'MOMENTOS Y FUERZAS QUE SE RESTAN
If lng < aa Then
fac = 0
fcc = 0
mfc = 0
mttc = 0
f33c = 0
m22c = 0
End If
If lng > aa Then 'Or lng = aa Then
fac = q
fcc = 0
mfc = 0
mttc = 0
f33c = 0
m22c = 0
End If
End If

'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'X------------CARGA PUNTUAL - EJE 2------------X
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

If Hoja8.Cells(13 + 22 * (n - 1), 7 + 3 * (nc - 1)) = "FUPU2" Then
'DATOS UTILIZADOS PARA ESTE TIPO DE CARGA
q = Hoja8.Cells(13 + 22 * (n - 1), 9 + 3 * (nc - 1))
aa = Hoja8.Cells(13 + 22 * (n - 1), 8 + 3 * (nc - 1))
'LONGITUDES DESDE EL INICIO HASTA EL CORTE
Hoja8.Cells(22 * (n - 1) + 19 + 3, 3 + m) = lng
'MOMENTOS Y FUERZAS QUE SE RESTAN
If lng < aa Then
fac = 0
fcc = 0
mfc = 0
mttc = 0
f33c = 0
m22c = 0
End If
If lng > aa Then 'Or lng = aa Then
fac = 0
fcc = -q
mfc = -q * (lng - aa)
mttc = 0
f33c = 0
m22c = 0
End If
End If

'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'X------------CARGA PUNTUAL - EJE 3------------X
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

If Hoja8.Cells(13 + 22 * (n - 1), 7 + 3 * (nc - 1)) = "FUPU3" Then
'DATOS UTILIZADOS PARA ESTE TIPO DE CARGA
q = Hoja8.Cells(13 + 22 * (n - 1), 9 + 3 * (nc - 1))
aa = Hoja8.Cells(13 + 22 * (n - 1), 8 + 3 * (nc - 1))
'LONGITUDES DESDE EL INICIO HASTA EL CORTE
Hoja8.Cells(22 * (n - 1) + 19 + 3, 3 + m) = lng
'MOMENTOS Y FUERZAS QUE SE RESTAN
If lng < aa Then
fac = 0
fcc = 0
mfc = 0
mttc = 0
f33c = 0
m22c = 0
End If
If lng > aa Then 'Or lng = aa Then
fac = 0
fcc = 0
mfc = 0
mttc = 0
f33c = -q
m22c = -q * (lng - aa)
End If
End If

'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'X-----------MOMENTO PUNTUAL - EJE 1-----------X
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

If Hoja8.Cells(13 + 22 * (n - 1), 7 + 3 * (nc - 1)) = "MOPU1" Then
'DATOS UTILIZADOS PARA ESTE TIPO DE CARGA
q = Hoja8.Cells(13 + 22 * (n - 1), 9 + 3 * (nc - 1))
aa = Hoja8.Cells(13 + 22 * (n - 1), 8 + 3 * (nc - 1))
'LONGITUDES DESDE EL INICIO HASTA EL CORTE
Hoja8.Cells(22 * (n - 1) + 19 + 3, 3 + m) = lng
'MOMENTOS Y FUERZAS QUE SE RESTAN
If lng < aa Then
fac = 0
fcc = 0
mfc = 0
mttc = 0
f33c = 0
m22c = 0
End If
If lng > aa Then 'Or lng = aa Then
fac = 0
fcc = 0
mfc = 0
mttc = -q
f33c = 0
m22c = 0
End If
End If

'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'X-----------MOMENTO PUNTUAL - EJE 2-----------X
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

If Hoja8.Cells(13 + 22 * (n - 1), 7 + 3 * (nc - 1)) = "MOPU2" Then
'DATOS UTILIZADOS PARA ESTE TIPO DE CARGA
q = Hoja8.Cells(13 + 22 * (n - 1), 9 + 3 * (nc - 1))
aa = Hoja8.Cells(13 + 22 * (n - 1), 8 + 3 * (nc - 1))
'LONGITUDES DESDE EL INICIO HASTA EL CORTE
Hoja8.Cells(22 * (n - 1) + 19 + 3, 3 + m) = lng
'MOMENTOS Y FUERZAS QUE SE RESTAN
If lng < aa Then
fac = 0
fcc = 0
mfc = 0
mttc = 0
f33c = 0
m22c = 0
End If
If lng > aa Then 'Or lng = aa Then
fac = 0
fcc = 0
mfc = 0
mttc = 0
f33c = 0
m22c = -q
End If
End If

'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'X-----------MOMENTO PUNTUAL - EJE 3-----------X
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

If Hoja8.Cells(13 + 22 * (n - 1), 7 + 3 * (nc - 1)) = "MOPU3" Then
'DATOS UTILIZADOS PARA ESTE TIPO DE CARGA
q = Hoja8.Cells(13 + 22 * (n - 1), 9 + 3 * (nc - 1))
aa = Hoja8.Cells(13 + 22 * (n - 1), 8 + 3 * (nc - 1))
'LONGITUDES DESDE EL INICIO HASTA EL CORTE
Hoja8.Cells(22 * (n - 1) + 19 + 3, 3 + m) = lng
'MOMENTOS Y FUERZAS QUE SE RESTAN
If lng < aa Then
fac = 0
fcc = 0
mfc = 0
mttc = 0
f33c = 0
m22c = 0
End If
If lng > aa Then 'Or lng = aa Then
fac = 0
fcc = 0
mfc = q
mttc = 0
f33c = 0
m22c = 0
End If
End If

'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'X-----------------TEMPERATURA-----------------X
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

If Hoja8.Cells(13 + 22 * (n - 1), 7 + 3 * (nc - 1)) = "TEMP" Then
'DATOS UTILIZADOS PARA ESTE TIPO DE CARGA
q = Hoja8.Cells(13 + 22 * (n - 1), 9 + 3 * (nc - 1))
'LONGITUDES DESDE EL INICIO HASTA EL CORTE
Hoja8.Cells(22 * (n - 1) + 19 + 3, 3 + m) = lng
'MOMENTOS Y FUERZAS QUE SE RESTAN
fac = 0
fcc = 0
mfc = 0
mttc = 0
f33c = 0
m22c = 0

End If

'ACUMULACION DE FUERAZS Y MOMENTOS QUE SE RESTAN
faat = fac + faat
fcct = fcc + fcct
mfct = mfc + mfct
mttct = mttc + mttct
f33ct = f33c + f33ct
m22ct = m22c + m22ct

'MF FC Y FA FINAL EN CADA CORTE
Hoja8.Cells(22 * (n - 1) + 19 + 4, 3 + m) = fa + faat

Hoja8.Cells(22 * (n - 1) + 19 + 5, 3 + m) = fc - fcct
Hoja8.Cells(22 * (n - 1) + 19 + 6, 3 + m) = mf - fc * lng + mfct
Hoja8.Cells(22 * (n - 1) + 19 + 7, 3 + m) = mtt - mttct
Hoja8.Cells(22 * (n - 1) + 19 + 8, 3 + m) = f33 - f33ct
Hoja8.Cells(22 * (n - 1) + 19 + 9, 3 + m) = m22 + f33 * lng - m22ct
Next

'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'X-----GRAFICA DE DIAGRAMAS------X
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'X------MOMENTO FLECTOR 33-------X
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

'COORDENADAS INICIALES DE LAS LINEAS DEL DIAGRAMA
x1 = Hoja8.Cells(11 + 22 * (n - 1), 5) * Hoja8.Cells(22 * (n - 1) + 22, 3 + m) +
Hoja8.Cells(11 + 22 * (n - 1), 3)
y1 = Hoja8.Cells(12 + 22 * (n - 1), 5) * Hoja8.Cells(22 * (n - 1) + 22, 3 + m) +
Hoja8.Cells(12 + 22 * (n - 1), 3)
z1 = Hoja8.Cells(15 + 22 * (n - 1), 5) * Hoja8.Cells(22 * (n - 1) + 22, 3 + m) +
Hoja8.Cells(15 + 22 * (n - 1), 3)
'COORDENADAS FINALES DE LAS LINEAS DEL DIAGRAMA
x2 = Hoja8.Cells(13 + 22 * (n - 1), 5) * Hoja8.Cells(22 * (n - 1) + 25, 3 + m) /
escalm33 + x1
y2 = Hoja8.Cells(14 + 22 * (n - 1), 5) * Hoja8.Cells(22 * (n - 1) + 25, 3 + m) /
escalm33 + y1
z2 = Hoja8.Cells(16 + 22 * (n - 1), 5) * Hoja8.Cells(22 * (n - 1) + 25, 3 + m) /
escalm33 + z1
'GRAFICAR DIAGRAMAS
Set AcadDoc = GetObject(, "Autocad.Application").ActiveDocument

Set AcadDocEM = AcadDoc.ModelSpace

'DEFINIR PUNTOS INICIAL Y FINAL DE CADA LINEA
Pt1(1) = x1 + 4 * sep: Pt1(2) = y1: Pt1(3) = z1
Pt2(1) = x2 + 4 * sep: Pt2(2) = y2: Pt2(3) = z2
Set ObjLinea = AcadDocEM.AddLine(Pt1, Pt2)
'ELEGIR COLOR DE LA LINEA (CELESTE)
If Hoja8.Cells(22 * (n - 1) + 25, 3 + m) > 0 Then
ObjLinea.Color = 52
End If
If Hoja8.Cells(22 * (n - 1) + 25, 3 + m) < 0 Then
ObjLinea.Color = 52
End If
'UNIR LOS PUNTOS FINALES DE CADA LINEA PARA FORMAR LA
CURVA O RECTA DE EXTREMO A EXTREMO
If m > 0 Then
Pt7(1) = aa1 + 4 * sep: Pt7(2) = aa2: Pt7(3) = aa3
Pt8(1) = x2 + 4 * sep: Pt8(2) = y2: Pt8(3) = z2
Set ObjLinea = AcadDocEM.AddLine(Pt7, Pt8)
End If
aa1 = x2
aa2 = y2
aa3 = z2
'COLOCAR VALORES EXTREMOS EN EL DIAGRAMA
If m = 0 Or m = ncort + 1 Then
Dim TextPosition1(0 To 2) As Double
TextPosition1(0) = Pt2(1)
TextPosition1(1) = Pt2(2)
TextPosition1(2) = Pt2(3)

AcadDocEM.addtext Round(Hoja8.Cells(25 + 22 * (n - 1), 3 + m),
numdecim), TextPosition1, escaltext

'**********************************************************
*********
'**********************************************************
*********
'**********************************************************
*********
'**********************************************************
*********
'PONIENDO TITULO A LOS DIAGRAMAS
Dim txtTitulo1(1 To 3) As Double
txtTitulo1(1) = 40
txtTitulo1(2) = -5
txtTitulo1(3) = 0
AcadDocEM.addtext "MOMENTO 3-3", txtTitulo1, escaltext * 10
'----------------------------------------------------------------txtTitulo1(1) = 60
txtTitulo1(2) = -5
txtTitulo1(3) = 0
AcadDocEM.addtext "F. C. 2-2", txtTitulo1, escaltext * 10

'----------------------------------------------------------------txtTitulo1(1) = 80
txtTitulo1(2) = -5
txtTitulo1(3) = 0
AcadDocEM.addtext "FUERZA AXIAL", txtTitulo1, escaltext * 10
'----------------------------------------------------------------txtTitulo1(1) = 100
txtTitulo1(2) = -5

txtTitulo1(3) = 0
AcadDocEM.addtext "M.FLECTOR 2-2", txtTitulo1, escaltext * 10
'----------------------------------------------------------------txtTitulo1(1) = 120
txtTitulo1(2) = -5
txtTitulo1(3) = 0
AcadDocEM.addtext "F.C. EN 3-3", txtTitulo1, escaltext * 10
'----------------------------------------------------------------txtTitulo1(1) = 140
txtTitulo1(2) = -5
txtTitulo1(3) = 0
AcadDocEM.addtext "M. TORSOR", txtTitulo1, escaltext * 10

'----------------------------------------------------------------txtTitulo1(1) = 50
txtTitulo1(2) = -15
txtTitulo1(3) = 0
AcadDocEM.addtext "ADERLIN BALDEON ROMERO", txtTitulo1,
escaltext * 30
'**********************************************************
*********
'**********************************************************
*********
'**********************************************************
*********
'**********************************************************
*********
'**********************************************************
*********

End If

'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'X------FUERZA CORATNATE 22------X
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

'COORDENADAS INICIALES DE LAS LINEAS DEL DIAGRAMA
x11 = Hoja8.Cells(11 + 22 * (n - 1), 5) * Hoja8.Cells(22 * (n - 1) + 22, 3 + m) +
Hoja8.Cells(11 + 22 * (n - 1), 3)
y11 = Hoja8.Cells(12 + 22 * (n - 1), 5) * Hoja8.Cells(22 * (n - 1) + 22, 3 + m) +
Hoja8.Cells(12 + 22 * (n - 1), 3)
z11 = Hoja8.Cells(15 + 22 * (n - 1), 5) * Hoja8.Cells(22 * (n - 1) + 22, 3 + m) +
Hoja8.Cells(15 + 22 * (n - 1), 3)
'COORDENADAS FINALES DE LAS LINEAS DEL DIAGRAMA
x22 = -Hoja8.Cells(13 + 22 * (n - 1), 5) * Hoja8.Cells(22 * (n - 1) + 24, 3 + m) /
escalc22 + x1
y22 = -Hoja8.Cells(14 + 22 * (n - 1), 5) * Hoja8.Cells(22 * (n - 1) + 24, 3 + m) /
escalc22 + y1
z22 = -Hoja8.Cells(16 + 22 * (n - 1), 5) * Hoja8.Cells(22 * (n - 1) + 24, 3 + m) /
escalc22 + z1
'GRAFICAR DIAGRAMAS
Set AcadDoc = GetObject(, "Autocad.Application").ActiveDocument
Set AcadDocEM = AcadDoc.ModelSpace

'DEFINIR PUNTOS INICIAL Y FINAL DE CADA LINEA
Pt1(1) = x11 + 6 * sep: Pt1(2) = y11: Pt1(3) = z11
Pt2(1) = x22 + 6 * sep: Pt2(2) = y22: Pt2(3) = z22
Set ObjLinea = AcadDocEM.AddLine(Pt1, Pt2)
'ELEGIR COLOR DE LA LINEA (CELESTE)
If Hoja8.Cells(22 * (n - 1) + 24, 3 + m) > 0 Then
ObjLinea.Color = 52
End If

If Hoja8.Cells(22 * (n - 1) + 24, 3 + m) < 0 Then
ObjLinea.Color = 52
End If
'UNIR LOS PUNTOS FINALES DE CADA LINEA PARA FORMAR LA
CURVA O RECTA DE EXTREMO A EXTREMO
If m > 0 Then
Pt7(1) = aa11 + 6 * sep: Pt7(2) = aa22: Pt7(3) = aa33
Pt8(1) = x22 + 6 * sep: Pt8(2) = y22: Pt8(3) = z22
Set ObjLinea = AcadDocEM.AddLine(Pt7, Pt8)
End If
aa11 = x22
aa22 = y22
aa33 = z22
'COLOCAR VALORES EXTREMOS EN EL DIAGRAMA
If m = 0 Or m = ncort + 1 Then
TextPosition1(0) = Pt2(1)
TextPosition1(1) = Pt2(2)
TextPosition1(2) = Pt2(3)
AcadDocEM.addtext Round(Hoja8.Cells(24 + 22 * (n - 1), 3 + m),
numdecim), TextPosition1, escaltext
End If

'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'X---------FUERZA AXIAL----------X
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

'COORDENADAS INICIALES DE LAS LINEAS DEL DIAGRAMA
x111 = Hoja8.Cells(11 + 22 * (n - 1), 5) * Hoja8.Cells(22 * (n - 1) + 22, 3 + m) +
Hoja8.Cells(11 + 22 * (n - 1), 3)

y111 = Hoja8.Cells(12 + 22 * (n - 1), 5) * Hoja8.Cells(22 * (n - 1) + 22, 3 + m) +
Hoja8.Cells(12 + 22 * (n - 1), 3)
z111 = Hoja8.Cells(15 + 22 * (n - 1), 5) * Hoja8.Cells(22 * (n - 1) + 22, 3 + m) +
Hoja8.Cells(15 + 22 * (n - 1), 3)
'COORDENADAS FINALES DE LAS LINEAS DEL DIAGRAMA
x222 = -Hoja8.Cells(13 + 22 * (n - 1), 5) * Hoja8.Cells(22 * (n - 1) + 23, 3 + m) /
escalaxi + x1
y222 = -Hoja8.Cells(14 + 22 * (n - 1), 5) * Hoja8.Cells(22 * (n - 1) + 23, 3 + m) /
escalaxi + y1
z222 = -Hoja8.Cells(16 + 22 * (n - 1), 5) * Hoja8.Cells(22 * (n - 1) + 23, 3 + m) /
escalaxi + z1
'GRAFICAR DIAGRAMAS
Set AcadDoc = GetObject(, "Autocad.Application").ActiveDocument
Set AcadDocEM = AcadDoc.ModelSpace

'DEFINIR PUNTOS INICIAL Y FINAL DE CADA LINEA
Pt1(1) = x111 + 8 * sep: Pt1(2) = y111: Pt1(3) = z111
Pt2(1) = x222 + 8 * sep: Pt2(2) = y222: Pt2(3) = z222
Set ObjLinea = AcadDocEM.AddLine(Pt1, Pt2)
'ELEGIR COLOR DE LA LINEA (CELESTE)
If Hoja8.Cells(22 * (n - 1) + 23, 3 + m) > 0 Then
ObjLinea.Color = 52
End If
If Hoja8.Cells(22 * (n - 1) + 23, 3 + m) < 0 Then
ObjLinea.Color = 52
End If
'UNIR LOS PUNTOS FINALES DE CADA LINEA PARA FORMAR LA
CURVA O RECTA DE EXTREMO A EXTREMO
If m > 0 Then
Pt7(1) = aa111 + 8 * sep: Pt7(2) = aa222: Pt7(3) = aa333
Pt8(1) = x222 + 8 * sep: Pt8(2) = y222: Pt8(3) = z222

Set ObjLinea = AcadDocEM.AddLine(Pt7, Pt8)
End If
aa111 = x222
aa222 = y222
aa333 = z222
'COLOCAR VALORES EXTREMOS EN EL DIAGRAMA
If m = 0 Or m = ncort + 1 Then
TextPosition1(0) = Pt2(1)
TextPosition1(1) = Pt2(2)
TextPosition1(2) = Pt2(3)
AcadDocEM.addtext Round(Hoja8.Cells(23 + 22 * (n - 1), 3 + m),
numdecim), TextPosition1, escaltext
End If

'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'X------MOMENTO FLECTOR 22-------X
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

'COORDENADAS INICIALES DE LAS LINEAS DEL DIAGRAMA
x1a = Hoja8.Cells(11 + 22 * (n - 1), 5) * Hoja8.Cells(22 * (n - 1) + 22, 3 + m) +
Hoja8.Cells(11 + 22 * (n - 1), 3)
y1a = Hoja8.Cells(12 + 22 * (n - 1), 5) * Hoja8.Cells(22 * (n - 1) + 22, 3 + m) +
Hoja8.Cells(12 + 22 * (n - 1), 3)
z1a = Hoja8.Cells(15 + 22 * (n - 1), 5) * Hoja8.Cells(22 * (n - 1) + 22, 3 + m) +
Hoja8.Cells(15 + 22 * (n - 1), 3)
'COORDENADAS FINALES DE LAS LINEAS DEL DIAGRAMA
x2a = -Hoja8.Cells(17 + 22 * (n - 1), 5) * Hoja8.Cells(22 * (n - 1) + 28, 3 + m) /
escalm22 + x1a
y2a = -Hoja8.Cells(18 + 22 * (n - 1), 5) * Hoja8.Cells(22 * (n - 1) + 28, 3 + m) /
escalm22 + y1a

z2a = -Hoja8.Cells(19 + 22 * (n - 1), 5) * Hoja8.Cells(22 * (n - 1) + 28, 3 + m) /
escalm22 + z1a
'GRAFICAR DIAGRAMAS
Set AcadDoc = GetObject(, "Autocad.Application").ActiveDocument
Set AcadDocEM = AcadDoc.ModelSpace

'DEFINIR PUNTOS INICIAL Y FINAL DE CADA LINEA
Pt1(1) = x1a + 10 * sep: Pt1(2) = y1a: Pt1(3) = z1a
Pt2(1) = x2a + 10 * sep: Pt2(2) = y2a: Pt2(3) = z2a
Set ObjLinea = AcadDocEM.AddLine(Pt1, Pt2)
'ELEGIR COLOR DE LA LINEA (CELESTE)
If Hoja8.Cells(22 * (n - 1) + 28, 3 + m) > 0 Then
ObjLinea.Color = 52
End If
If Hoja8.Cells(22 * (n - 1) + 28, 3 + m) < 0 Then
ObjLinea.Color = 52
End If
'UNIR LOS PUNTOS FINALES DE CADA LINEA PARA FORMAR LA
CURVA O RECTA DE EXTREMO A EXTREMO
If m > 0 Then
Pt7(1) = aa1a + 10 * sep: Pt7(2) = aa2a: Pt7(3) = aa3a
Pt8(1) = x2a + 10 * sep: Pt8(2) = y2a: Pt8(3) = z2a
Set ObjLinea = AcadDocEM.AddLine(Pt7, Pt8)
End If
aa1a = x2a
aa2a = y2a
aa3a = z2a
'COLOCAR VALORES EXTREMOS EN EL DIAGRAMA
If m = 0 Or m = ncort + 1 Then

TextPosition1(0) = Pt2(1)
TextPosition1(1) = Pt2(2)
TextPosition1(2) = Pt2(3)
AcadDocEM.addtext Round(Hoja8.Cells(28 + 22 * (n - 1), 3 + m),
numdecim), TextPosition1, escaltext
End If

'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'X------FUERZA CORTANTE 33-------X
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

'COORDENADAS INICIALES DE LAS LINEAS DEL DIAGRAMA
x1aa = Hoja8.Cells(11 + 22 * (n - 1), 5) * Hoja8.Cells(22 * (n - 1) + 22, 3 + m) +
Hoja8.Cells(11 + 22 * (n - 1), 3)
y1aa = Hoja8.Cells(12 + 22 * (n - 1), 5) * Hoja8.Cells(22 * (n - 1) + 22, 3 + m) +
Hoja8.Cells(12 + 22 * (n - 1), 3)
z1aa = Hoja8.Cells(15 + 22 * (n - 1), 5) * Hoja8.Cells(22 * (n - 1) + 22, 3 + m) +
Hoja8.Cells(15 + 22 * (n - 1), 3)
'COORDENADAS FINALES DE LAS LINEAS DEL DIAGRAMA
x2aa = -Hoja8.Cells(17 + 22 * (n - 1), 5) * Hoja8.Cells(22 * (n - 1) + 27, 3 + m) /
escalc33 + x1aa
y2aa = -Hoja8.Cells(18 + 22 * (n - 1), 5) * Hoja8.Cells(22 * (n - 1) + 27, 3 + m) /
escalc33 + y1aa
z2aa = -Hoja8.Cells(19 + 22 * (n - 1), 5) * Hoja8.Cells(22 * (n - 1) + 27, 3 + m) /
escalc33 + z1aa
'GRAFICAR DIAGRAMAS
Set AcadDoc = GetObject(, "Autocad.Application").ActiveDocument
Set AcadDocEM = AcadDoc.ModelSpace

'DEFINIR PUNTOS INICIAL Y FINAL DE CADA LINEA
Pt1(1) = x1aa + 12 * sep: Pt1(2) = y1aa: Pt1(3) = z1aa

Pt2(1) = x2aa + 12 * sep: Pt2(2) = y2aa: Pt2(3) = z2aa
Set ObjLinea = AcadDocEM.AddLine(Pt1, Pt2)
'ELEGIR COLOR DE LA LINEA (CELESTE)
If Hoja8.Cells(22 * (n - 1) + 27, 3 + m) > 0 Then
ObjLinea.Color = 52
End If
If Hoja8.Cells(22 * (n - 1) + 27, 3 + m) < 0 Then
ObjLinea.Color = 52
End If
'UNIR LOS PUNTOS FINALES DE CADA LINEA PARA FORMAR LA
CURVA O RECTA DE EXTREMO A EXTREMO
If m > 0 Then
Pt7(1) = aa1aa + 12 * sep: Pt7(2) = aa2aa: Pt7(3) = aa3aa
Pt8(1) = x2aa + 12 * sep: Pt8(2) = y2aa: Pt8(3) = z2aa
Set ObjLinea = AcadDocEM.AddLine(Pt7, Pt8)
End If
aa1aa = x2aa
aa2aa = y2aa
aa3aa = z2aa
'COLOCAR VALORES EXTREMOS EN EL DIAGRAMA
If m = 0 Or m = ncort + 1 Then
TextPosition1(0) = Pt2(1)
TextPosition1(1) = Pt2(2)
TextPosition1(2) = Pt2(3)
AcadDocEM.addtext Round(Hoja8.Cells(27 + 22 * (n - 1), 3 + m),
numdecim), TextPosition1, escaltext
End If

'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

'X--------MOMENTO TORSOR---------X
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

'COORDENADAS INICIALES DE LAS LINEAS DEL DIAGRAMA
x111a = Hoja8.Cells(11 + 22 * (n - 1), 5) * Hoja8.Cells(22 * (n - 1) + 22, 3 + m) +
Hoja8.Cells(11 + 22 * (n - 1), 3)
y111a = Hoja8.Cells(12 + 22 * (n - 1), 5) * Hoja8.Cells(22 * (n - 1) + 22, 3 + m) +
Hoja8.Cells(12 + 22 * (n - 1), 3)
z111a = Hoja8.Cells(15 + 22 * (n - 1), 5) * Hoja8.Cells(22 * (n - 1) + 22, 3 + m) +
Hoja8.Cells(15 + 22 * (n - 1), 3)
'COORDENADAS FINALES DE LAS LINEAS DEL DIAGRAMA
x222a = -Hoja8.Cells(13 + 22 * (n - 1), 5) * Hoja8.Cells(22 * (n - 1) + 26, 3 + m) /
escaltor + x111a
y222a = -Hoja8.Cells(14 + 22 * (n - 1), 5) * Hoja8.Cells(22 * (n - 1) + 26, 3 + m) /
escaltor + y111a
z222a = -Hoja8.Cells(16 + 22 * (n - 1), 5) * Hoja8.Cells(22 * (n - 1) + 26, 3 + m) /
escaltor + z111a
'GRAFICAR DIAGRAMAS
Set AcadDoc = GetObject(, "Autocad.Application").ActiveDocument
Set AcadDocEM = AcadDoc.ModelSpace

'DEFINIR PUNTOS INICIAL Y FINAL DE CADA LINEA
Pt1(1) = x111a + 14 * sep: Pt1(2) = y111a: Pt1(3) = z111a
Pt2(1) = x222a + 14 * sep: Pt2(2) = y222a: Pt2(3) = z222a
Set ObjLinea = AcadDocEM.AddLine(Pt1, Pt2)
'ELEGIR COLOR DE LA LINEA (CELESTE)
If Hoja8.Cells(22 * (n - 1) + 26, 3 + m) > 0 Then
ObjLinea.Color = 52
End If
If Hoja8.Cells(22 * (n - 1) + 26, 3 + m) < 0 Then
ObjLinea.Color = 52

End If
'UNIR LOS PUNTOS FINALES DE CADA LINEA PARA FORMAR LA
CURVA O RECTA DE EXTREMO A EXTREMO
If m > 0 Then
Pt7(1) = aa111a + 14 * sep: Pt7(2) = aa222a: Pt7(3) = aa333a
Pt8(1) = x222a + 14 * sep: Pt8(2) = y222a: Pt8(3) = z222a
Set ObjLinea = AcadDocEM.AddLine(Pt7, Pt8)
End If
aa111a = x222a
aa222a = y222a
aa333a = z222a
'COLOCAR VALORES EXTREMOS EN EL DIAGRAMA
If m = 0 Or m = ncort + 1 Then
TextPosition1(0) = Pt2(1)
TextPosition1(1) = Pt2(2)
TextPosition1(2) = Pt2(3)
AcadDocEM.addtext Round(Hoja8.Cells(26 + 22 * (n - 1), 3 + m),
numdecim), TextPosition1, escaltext
End If
Next
Next

End Sub

Private Sub CommandButton8_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
CommandButton10.Enabled = True
End Sub

Dim a, b
Private Sub ELIMINARFILA_Click()
If lx.ListIndex <> -1 Then
a = lnum.ListIndex
lnum.RemoveItem lnum.ListIndex
lx.RemoveItem a
ly.RemoveItem a
lz.RemoveItem a

txtx.SetFocus
txtx = ""
txty = ""
txtz = ""
txtx.SetFocus
CommandButton1.Enabled = False
cb1.Value = False
Else
MsgBox ("DEBES SELECCIONAR LA MISMA FILA DE NUM , X, Y ,Z")
End If
End Sub

Private Sub ELIMINARFILAE_Click()
Dim a
If lnu.ListIndex <> -1 Then
a = lnu.ListIndex
lnu.RemoveItem a
li.RemoveItem a
lj.RemoveItem a

txtnu.SetFocus
txti = ""
txtj = ""
CommandButton3.Enabled = False
cb3.Value = False
Else
MsgBox ("DEBES SELECCIONAR LA MISMA FILA DE NUM NUM ,i ,j")
End If
End Sub

Private Sub Frame12_Click()

End Sub

Private Sub Frame12_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X
As Single, ByVal Y As Single)

End Sub

Private Sub Frame14_Click()

End Sub

Private Sub Frame6_Click()

End Sub

Private Sub Frame7_Click()

End Sub

Private Sub Image2_Click()
Frame5.Visible = True
Frame6.Visible = True
Frame7.Visible = True
Frame9.Visible = True
Frame12.Visible = True
Frame1.Top = 186
Frame2.Top = 186
Frame4.Top = 186
Frame1.Height = 270
Frame2.Height = 270
Frame4.Height = 270
lnum.Height = 200
lx.Height = 200
ly.Height = 200
lz.Height = 200
lnu.Height = 200
li.Height = 200
lj.Height = 200
lelem.Height = 200
le.Height = 200
lg.Height = 200
lu.Height = 200
lb.Height = 200
lh.Height = 200
ld.Height = 200
lang.Height = 200

ltipo.Height = 200
lt.Height = 200
Image2.BackColor = &H8000000F
End Sub

Private Sub Label27_Click()

End Sub

Private Sub Label41_Click()

End Sub

Private Sub Label50_Click()

End Sub

Private Sub Label52_Click()

End Sub

Private Sub Label53_Click()

End Sub

Private Sub Label56_Click()

End Sub

Private Sub lang_Click()
le.Selected(lang.ListIndex) = True
lg.Selected(lang.ListIndex) = True
lu.Selected(lang.ListIndex) = True
lb.Selected(lang.ListIndex) = True
lh.Selected(lang.ListIndex) = True
ld.Selected(lang.ListIndex) = True
lelem.Selected(lang.ListIndex) = True
ltipo.Selected(lang.ListIndex) = True
End Sub

Private Sub lb_Click()
le.Selected(lb.ListIndex) = True
lg.Selected(lb.ListIndex) = True
lu.Selected(lb.ListIndex) = True
lelem.Selected(lb.ListIndex) = True
lh.Selected(lb.ListIndex) = True
ld.Selected(lb.ListIndex) = True
lang.Selected(lb.ListIndex) = True
ltipo.Selected(lb.ListIndex) = True
End Sub

Private Sub ld_Click()
le.Selected(ld.ListIndex) = True
lg.Selected(ld.ListIndex) = True
lu.Selected(ld.ListIndex) = True
lb.Selected(ld.ListIndex) = True
lh.Selected(ld.ListIndex) = True

lelem.Selected(ld.ListIndex) = True
lang.Selected(ld.ListIndex) = True
ltipo.Selected(ld.ListIndex) = True
End Sub

Private Sub le_Click()
lelem.Selected(le.ListIndex) = True
lg.Selected(le.ListIndex) = True
lu.Selected(le.ListIndex) = True
lb.Selected(le.ListIndex) = True
lh.Selected(le.ListIndex) = True
ld.Selected(le.ListIndex) = True
lang.Selected(le.ListIndex) = True
ltipo.Selected(le.ListIndex) = True
End Sub

Private Sub lelem_Click()
le.Selected(lelem.ListIndex) = True
lg.Selected(lelem.ListIndex) = True
lu.Selected(lelem.ListIndex) = True
lb.Selected(lelem.ListIndex) = True
lh.Selected(lelem.ListIndex) = True
ld.Selected(lelem.ListIndex) = True
lang.Selected(lelem.ListIndex) = True
ltipo.Selected(lelem.ListIndex) = True

End Sub

Private Sub lg_Click()

le.Selected(lg.ListIndex) = True
lelem.Selected(lg.ListIndex) = True
lu.Selected(lg.ListIndex) = True
lb.Selected(lg.ListIndex) = True
lh.Selected(lg.ListIndex) = True
ld.Selected(lg.ListIndex) = True
lang.Selected(lg.ListIndex) = True
ltipo.Selected(lg.ListIndex) = True
End Sub

Private Sub lh_Click()
le.Selected(lh.ListIndex) = True
lg.Selected(lh.ListIndex) = True
lu.Selected(lh.ListIndex) = True
lb.Selected(lh.ListIndex) = True
lelem.Selected(lh.ListIndex) = True
ld.Selected(lh.ListIndex) = True
lang.Selected(lh.ListIndex) = True
ltipo.Selected(lh.ListIndex) = True
End Sub

Private Sub li_Click()
lnu.Selected(li.ListIndex) = True
lj.Selected(li.ListIndex) = True
End Sub

Private Sub ListBox2_Click()

End Sub

Private Sub lj_Click()
lnu.Selected(lj.ListIndex) = True
li.Selected(lj.ListIndex) = True
End Sub

Private Sub lnu_Click()
li.Selected(lnu.ListIndex) = True
lj.Selected(lnu.ListIndex) = True

End Sub

Private Sub lnum_Click()
lx.Selected(lnum.ListIndex) = True
ly.Selected(lnum.ListIndex) = True
lz.Selected(lnum.ListIndex) = True
End Sub

Private Sub ltipo_Click()
le.Selected(ltipo.ListIndex) = True
lg.Selected(ltipo.ListIndex) = True
lelem.Selected(ltipo.ListIndex) = True
lb.Selected(ltipo.ListIndex) = True
lh.Selected(ltipo.ListIndex) = True
ld.Selected(ltipo.ListIndex) = True
lang.Selected(ltipo.ListIndex) = True
lu.Selected(ltipo.ListIndex) = True
End Sub

Private Sub lu_Click()
le.Selected(lu.ListIndex) = True
lg.Selected(lu.ListIndex) = True
lelem.Selected(lu.ListIndex) = True
lb.Selected(lu.ListIndex) = True
lh.Selected(lu.ListIndex) = True
ld.Selected(lu.ListIndex) = True
lang.Selected(lu.ListIndex) = True
ltipo.Selected(lu.ListIndex) = True
End Sub

Private Sub lx_Click()

lnum.Selected(lx.ListIndex) = True
ly.Selected(lx.ListIndex) = True
lz.Selected(lx.ListIndex) = True

End Sub

Private Sub ly_Click()
lnum.Selected(ly.ListIndex) = True
lx.Selected(ly.ListIndex) = True
lz.Selected(ly.ListIndex) = True
End Sub

Private Sub lz_Click()
lnum.Selected(lz.ListIndex) = True
lx.Selected(lz.ListIndex) = True
ly.Selected(lz.ListIndex) = True

End Sub

Private Sub optc_Click()

End Sub

Private Sub OptionButton1_Change()
If OptionButton1.Value = True Then
txtg.Enabled = True
txtu.Text = "0"
txtu.Enabled = False
txtg = ""
End If
End Sub

Private Sub OptionButton2_change()
If OptionButton2.Value = True Then
txtu.Enabled = True
txtu.Text = ""
txtg.Enabled = True
txtg.Text = "0"
txtg.Enabled = False

End If
End Sub

Private Sub OptionButton3_change()
If OptionButton3.Value = True Then

txtb.Enabled = True
txth.Enabled = True
txtd.Text = "0"
txtd.Enabled = False
txtb.Text = ""
txth.Text = ""
Else

End If
End Sub
Private Sub OptionButton4_change()
If OptionButton4.Value = True Then
txtb.Text = "0"
txth.Text = "0"
txtb.Enabled = False
txth.Enabled = False
txtd.Text = ""
txtd.Enabled = True

End If
End Sub

Private Sub OptionButton5_Click()
UserForm4.CommandButton2.Enabled = True
UserForm4.CommandButton3.Enabled = False

End Sub

Private Sub OptionButton6_Click()

UserForm4.CommandButton2.Enabled = False
UserForm4.CommandButton3.Enabled = True
End Sub

Private Sub OptionButton7_Click()
CommandButton12.Enabled = False
UserForm2.CommandButton4.Enabled = False
End Sub

Private Sub OptionButton8_Click()
CommandButton12.Enabled = False
UserForm2.CommandButton3.Enabled = False
End Sub

Private Sub txtang_Change()

End Sub

Private Sub txtang_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If InStr("0123456789." & Chr(8) & Chr(13), Chr(KeyAscii)) = 0 Then
KeyAscii = 0
End If
End Sub

Private Sub txtelem_Change()

End Sub

Private Sub txtelem_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If Not (KeyAscii >= 48 And KeyAscii <= 57 Or KeyAscii = 8) Then
KeyAscii = 0
End If
End Sub

Private Sub txtg_Change()

End Sub

Private Sub txtg_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As
Integer)

End Sub

Private Sub txtg_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

End Sub

Private Sub txti_Change()

End Sub

Private Sub txti_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If InStr("0123456789" & Chr(8) & Chr(13), Chr(KeyAscii)) = 0 Then
KeyAscii = 0
End If

End Sub

Private Sub txtj_Change()

End Sub

Private Sub txtj_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If InStr("0123456789" & Chr(8) & Chr(13), Chr(KeyAscii)) = 0 Then
KeyAscii = 0
End If
End Sub

Private Sub txtnu_Change()

End Sub

Private Sub txtnu_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If Not (KeyAscii >= 48 And KeyAscii <= 57 Or KeyAscii = 8) Then
KeyAscii = 0
End If
End Sub

Private Sub txtnum_Change()

End Sub

Private Sub txtnum_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If Not (KeyAscii >= 48 And KeyAscii <= 57 Or KeyAscii = 8) Then
KeyAscii = 0

End If
End Sub

Private Sub txty_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As
Integer)

If KeyCode = 13 Then
txtz.SetFocus
End If

End Sub
Private Sub txtz_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As
Integer)

If KeyCode = 13 Then
btnudo.SetFocus
End If

End Sub

Private Sub txtu_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As
Integer)

If KeyCode = 13 Then
txtb.SetFocus
End If

End Sub

Private Sub txtd_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As
Integer)

If KeyCode = 13 Then
btdato.SetFocus
End If

End Sub

'____________________________________ CARGAR Y MOFICAR LOS DATOS
INICIALES DE LA ESTRUCTURA ____________________________________________

'XXXXX CALCULAR DESPUES DE INGRESAR TODOS LOS DATOS XXXXX
Private Sub btrot_Click()

btmat.Enabled = True
btvec.Enabled = True

End Sub

'XXXXX HABILITAR OPCION DE MODIFICAR XXXXX
Private Sub cb4_Click()

If cb4.Value = True Then
CommandButton4.Enabled = True
Else: CommandButton4.Enabled = False
End If

End Sub

'XXXXX MODIFICAR DATOS DE ROTACION XXXXX
Private Sub CommandButton4_Click()

lelem.AddItem txtelem.Value, lelem.ListIndex
lang.AddItem txtang.Value, lang.ListIndex
a = lelem.ListIndex
lelem.RemoveItem a
lang.RemoveItem a
txtelem = ""
txtang = ""
txtelem.SetFocus
CommandButton4.Enabled = False
cb4.Value = False

End Sub

'XXXXX CARGAR TIPO DE ELEMENTOS XXXXX
Private Sub btelem_Click()
If Len(Trim(txtnu)) > 0 Then
a = txtnu.Value
lnu.AddItem txtnu.Value
li.AddItem txti.Value
lj.AddItem txtj.Value
txtnu = a + 1
txti = ""
txtj = ""
txti.SetFocus
CommandButton3.Enabled = False

cb3.Value = False
End If
End Sub

'XXXXX HABILITAR OPCION DE MODIFICAR XXXXX
Private Sub cb3_Click()

If cb3.Value = True Then
CommandButton3.Enabled = True
Else: CommandButton3.Enabled = False
End If

End Sub

'XXXXX MODIFICAR TIPO DE ELEMENTOS XXXXX
Private Sub CommandButton3_Click()

lnu.AddItem txtnu.Value, lnu.ListIndex
li.AddItem txti.Value, li.ListIndex
lj.AddItem txtj.Value, lj.ListIndex
a = lnu.ListIndex
lnu.RemoveItem a
li.RemoveItem a
lj.RemoveItem a
txti = ""
txtj = ""
txti.SetFocus
CommandButton3.Enabled = False
cb3.Value = False

End Sub

'XXXXX CARGAR DATOS DE ELEMENTOS XXXXX
Private Sub btdato_Click()
If Len(Trim(txtelem)) > 0 Then
lelem.AddItem txtelem.Value
lang.AddItem txtang.Value
If optv.Value = True Then
ltipo.AddItem optv.Caption
lt.AddItem 1
Else
If optc.Value = True Then
ltipo.AddItem optc.Caption
lt.AddItem 2
End If
End If
le.AddItem txte.Value
lg.AddItem txtg.Value
lu.AddItem txtu.Value
lb.AddItem txtb.Value
lh.AddItem txth.Value
ld.AddItem txtd.Value
txte.SetFocus
CommandButton2.Enabled = False
cb2.Value = False
txtelem = ""
txtang = "0"
txtelem.SetFocus

End If
End Sub

'XXXXX HABILITAR OPCION DE MODIFICAR XXXXX
Private Sub cb2_Click()

If cb2.Value = True Then
CommandButton2.Enabled = True
Else: CommandButton2.Enabled = False
End If

End Sub

'XXXXX MODIFICAR DATOS DE LOS ELEMENTOS XXXXX
Private Sub CommandButton2_Click()
yon = lelem.ListIndex
If optv.Value = True Then
ltipo.AddItem optv.Caption, ltipo.ListIndex
lt.AddItem 1, yon
Else
If optc.Value = True Then
ltipo.AddItem optc.Caption, ltipo.ListIndex
lt.AddItem 2, yon
End If
End If
le.AddItem txte.Value, le.ListIndex
lg.AddItem txtg.Value, lg.ListIndex
lu.AddItem txtu.Value, lu.ListIndex

lb.AddItem txtb.Value, lb.ListIndex
lh.AddItem txth.Value, lh.ListIndex
ld.AddItem txtd.Value, ld.ListIndex
a = ltipo.ListIndex
ltipo.RemoveItem a
lt.RemoveItem a
le.RemoveItem a
lg.RemoveItem a
lu.RemoveItem a
lb.RemoveItem a
lh.RemoveItem a
ld.RemoveItem a

txte.SetFocus
CommandButton2.Enabled = False
cb2.Value = False

End Sub

'XXXXX CARGAR DATOS DE LOS NUDOS XXXXX
Private Sub btnudo_Click()
If Len(Trim(txtnum)) > 0 Then
a = txtnum.Value
lnum.AddItem txtnum.Value
lx.AddItem txtx.Value
ly.AddItem txty.Value
lz.AddItem txtz.Value
txtnum = a + 1
txtx = ""

txty = ""
txtz = ""
txtx.SetFocus
CommandButton1.Enabled = False
cb1.Value = False
End If
End Sub

'XXXXX HABILITAR OPCION DE MODIFICAR XXXXX
Private Sub cb1_Click()

If cb1.Value = True Then
CommandButton1.Enabled = True
Else: CommandButton1.Enabled = False
End If

End Sub

'XXXXX MODIFICAR ELEMENTOS DE LOS NUDOS XXXXX
Private Sub CommandButton1_Click()

a = txtnum.Value
lnum.AddItem a, lnum.ListIndex
lx.AddItem txtx.Value, lx.ListIndex
ly.AddItem txty.Value, ly.ListIndex
lz.AddItem txtz.Value, lz.ListIndex
lnum.RemoveItem a
lx.RemoveItem a
ly.RemoveItem a

lz.RemoveItem a
txtx.SetFocus
txtx = ""
txty = ""
txtz = ""
txtx.SetFocus
CommandButton1.Enabled = False
cb1.Value = False

End Sub

'_________________________________________ GENERAR LAS MATRICES DE
RIGIDEZ __________________________________________________________

'XXXXX REDIMENSIONAR LISTAS A LOS TAMAÑOS DE LAS TABLAS DE INGRESO
XXXXX
Private Sub btmat_Click()

Application.ScreenUpdating = False
ReDim lsnn(1 To lnum.ListCount) As Double
ReDim lsx(1 To lx.ListCount) As Double
ReDim lsy(1 To ly.ListCount) As Double
ReDim lsz(1 To lz.ListCount) As Double
ReDim lsne(1 To lnu.ListCount) As Double
ReDim lsi(1 To li.ListCount) As Double
ReDim lsj(1 To lj.ListCount) As Double
ReDim lstip(1 To ltipo.ListCount) As String
ReDim lse(1 To le.ListCount) As Double
ReDim lsg(1 To lg.ListCount) As Double

ReDim lsu(1 To lu.ListCount) As Double
ReDim lsb(1 To lb.ListCount) As Double
ReDim lsh(1 To lh.ListCount) As Double
ReDim lsd(1 To ld.ListCount) As Double
ReDim lshp(1 To lhp.ListCount) As Double
ReDim lsbp(1 To lbp.ListCount) As Double
ReDim lstf(1 To ltf.ListCount) As Double
ReDim lstw(1 To ltw.ListCount) As Double
ReDim lstipodeseccion(1 To ltipodeseccion.ListCount) As Double
ReDim lsarea(1 To lnu.ListCount) As Double
ReDim lin2(1 To lnu.ListCount) As Double
ReDim lin3(1 To lnu.ListCount) As Double
ReDim linj(1 To lnu.ListCount) As Double
ReDim lser(1 To lelem.ListCount) As Double
ReDim lsa(1 To lang.ListCount) As Double

'XXXXX ASIGNAR VALORES A LISTAS XXXXX

a = lnum.ListCount
For i = 1 To a
lsnn(i) = lnum.List(i - 1)
Next
For i = 1 To a
lsx(i) = lx.List(i - 1)
Next
For i = 1 To a
lsy(i) = ly.List(i - 1)
Next

For i = 1 To a
lsz(i) = lz.List(i - 1)
Next

'XXX MANDAR DATOS A EXCELL DE NUDOS XXX
Hoja1.Activate
Hoja1.Cells(4, 3) = "COORDENADAS DE LOS NUDOS"
For i = 4 To 7
For j = 3 To 7
Hoja1.Cells(i, j).Font.Bold = True
Next
Next
'PARA PONER TITULO DE COORDENADAS Y NUDOS
Hoja1.Cells(6, 4) = "NUDO"
Hoja1.Cells(6, 6) = "COORDENADAS"
Hoja1.Cells(7, 5) = "X"
Hoja1.Cells(7, 6) = "Y"
Hoja1.Cells(7, 7) = "Z"
For i = 6 To lnum.ListCount + 7
For j = 4 To 7
Hoja1.Cells(i, j).Borders.LineStyle = 1
Next
Next
' PARA IMPORTAR NUDOS, X,Y y Z DEL FORMULARIO A HOJA
For i = 1 To a
Hoja1.Cells(i + 7, 4) = lsnn(i) 'NUDOS
Next
For i = 1 To a
Hoja1.Cells(i + 7, 5) = lsx(i) 'X

Next
For i = 1 To a
Hoja1.Cells(i + 7, 6) = lsy(i) 'Y
Next
For i = 1 To a
Hoja1.Cells(i + 7, 7) = lsz(i) 'Z
Next
'PARA LA TABLA DE ELEMENTOS
a = lnu.ListCount
For i = 1 To a

'NUMERACION DE ELEMENTOS

lsne(i) = lnu.List(i - 1)
Next
For i = 1 To a

'NUDO i

lsi(i) = li.List(i - 1)
Next
For i = 1 To a

'NUDO j

lsj(i) = lj.List(i - 1)
Next
For i = 1 To a

'TIPO DE ELEMENTO

lstip(i) = lt.List(i - 1)
Next
For i = 1 To a

'MODULO DE ELASTICIDAD

lse(i) = le.List(i - 1)
Next
For i = 1 To a

'MODULO DE CORTE

If lg.List(i - 1) = 0 Then
'SI EL MODULO DE CORTE ES CERO, LO CALCULA
DESDE EL VALOR DEL POISSON
lsg(i) = le.List(i - 1) / (2 * (1 + lu.List(i - 1)))
Else

lsg(i) = lg.List(i - 1)
UTILIZA ESE VALOR

'SI EL MODULO DE CORTE ES DIFERENTE DE CERO,

End If
Next
For i = 1 To a

'COEFICIENTE DE POISSON

lsu(i) = lu.List(i - 1)
Next
For i = 1 To a

'BASE DEL ELEMENTO RECTANGULAR

lsb(i) = lb.List(i - 1)
Next
For i = 1 To a

'ALTURA DEL ELEMENTO RECTANGULAR

lsh(i) = lh.List(i - 1)
Next
For i = 1 To a

'DIAMETRO DEL ELEMENTO CIRCULAR

lsd(i) = ld.List(i - 1)
Next

For i = 1 To a

'hp del perfil

lshp(i) = lhp.List(i - 1)
Next

For i = 1 To a

'bp del perfil

lsbp(i) = lbp.List(i - 1)
Next

For i = 1 To a
lstf(i) = ltf.List(i - 1)
Next

'tf del perfil

For i = 1 To a

'tw del perfil

lstw(i) = ltw.List(i - 1)
Next
For i = 1 To a

'tipo de seccion

lstipodeseccion(i) = ltipodeseccion.List(i - 1)
Next
For i = 1 To Val(lnu.ListCount)
'AREA DEL ELEMENTO RECTANGULAR
If ltipodeseccion.List(i - 1) = 1 Then
lsarea(i) = lsh(i) * lsb(i)
End If

'AREA DEL ELEMENTO CIRCULAR
If ltipodeseccion.List(i - 1) = 2 Then
lsarea(i) = 3.14159 * ld.List(i - 1) ^ 2 / 4
End If

'AREA DEL ELEMENTO PERFIL
If ltipodeseccion.List(i - 1) = 3 Then
lsarea(i) = ((lshp(i) - lstf(i)) * lstw(i)) + (2 * lstf(i) * lsbp(i))
End If
Next

For i = 1 To Val(lnu.ListCount)
If ltipodeseccion.List(i - 1) = 1 Then
RECTANGULAR
lin2(i) = lsh(i) * lsb(i) ^ 3 / 12
lin3(i) = lsb(i) * lsh(i) ^ 3 / 12

'MOMENTO DE INERCIA EJE 2,3

End If
If ltipodeseccion.List(i - 1) = 2 Then

'MOMENTO DE INERCIA EJE 2,3 CIRCULAR

lin2(i) = 3.14159 * ld.List(i - 1) ^ 4 / 64
lin3(i) = 3.14159 * ld.List(i - 1) ^ 4 / 64
End If
If ltipodeseccion.List(i - 1) = 3 Then

'MOMENTO DE INERCIA EJE 2,3 PERFIL

lin2(i) = (lstf(i) * (lsbp(i) ^ 3) / 6) + ((lshp(i) - lstf(i)) * (lstw(i) ^ 3) / 12)
lin3(i) = 2 * (((lsbp(i) * (lstf(i) ^ 3) / 12)) + ((lsbp(i) * lstf(i) * ((lshp(i) / 2) ^ 2)))) +
(lstw(i) * (lshp(i) - lstf(i)) ^ 3 / 12)
End If
Next

For i = 1 To a

'MOMENTO POLAR DE INERCIA

'rect
If ltipodeseccion.List(i - 1) = 1 Then
nnn = 0
rpp = 0
k=1
jjj = 0
Do Until nnn = 50 'Bucle con iteracion de hasta 30 veces
rqq = (1 / (k ^ 5)) * (((Exp((k * 3.141592 * lsh(i)) / (2 * lsb(i)))) - (Exp(((-1) * k *
3.141592 * lsh(i)) / (2 * lsb(i)))))) / (((Exp((k * 3.141592 * lsh(i)) / (2 * lsb(i)))) + (Exp(((-1) *
k * 3.141592 * lsh(i)) / (2 * lsb(i))))))
rpp = rpp + rqq

jjj = (1 / 3) * ((lsb(i)) ^ 3) * (lsh(i)) * (1 - ((192 * lsb(i)) / (lsh(i) * (3.141592 ^ 5))) *
(rpp))

k=k+2
nnn = nnn + 1
Loop
linj(i) = jjj
End If

'circulo

If ltipodeseccion.List(i - 1) = 2 Then
linj(i) = lin2(i) + lin3(i)
End If
'PERFIL
If ltipodeseccion.List(i - 1) = 3 Then
linj(i) = ((2 * lsbp(i) * (lstf(i) ^ 3)) + (lshp(i) * (lstw(i) ^ 3))) / 3 ''''esto no es seguro
comprobar
End If
Next

d = lelem.ListCount
For i = 1 To d

'NUMERO DE ELEMENTO A ROTAR

lser(i) = lelem.List(i - 1)
Next
For i = 1 To d

'ANGULO A ROTAR

lsa(i) = lang.List(i - 1)
Next

'XXX MANDAR DATOS A EXCELL DE ELEMENTOS XXX

a = lnu.ListCount
e = lnum.ListCount
Hoja1.Cells(lnum.ListCount + 10, 3) = "ELEMENTOS Y SUS PROPIEDADES"
Hoja1.Cells(lnum.ListCount + 12, 2) = "ELEMENTO"
Hoja1.Cells(lnum.ListCount + 12, 4) = "DIRECCION"
Hoja1.Cells(lnum.ListCount + 12, 5) = "TIPO"
Hoja1.Cells(lnum.ListCount + 12, 6) = "E"
Hoja1.Cells(lnum.ListCount + 12, 7) = "G"
Hoja1.Cells(lnum.ListCount + 12, 8) = "u"
Hoja1.Cells(lnum.ListCount + 12, 10) = "SECCION"
Hoja1.Cells(lnum.ListCount + 12, 17) = "INERCIA"
Hoja1.Cells(lnum.ListCount + 12, 20) = "ANG"
Hoja1.Cells(lnum.ListCount + 13, 3) = "i"
Hoja1.Cells(lnum.ListCount + 13, 4) = "j"
Hoja1.Cells(lnum.ListCount + 13, 9) = "b"
Hoja1.Cells(lnum.ListCount + 13, 10) = "h"
Hoja1.Cells(lnum.ListCount + 13, 11) = "d"
Hoja1.Cells(lnum.ListCount + 13, 12) = "hp"
Hoja1.Cells(lnum.ListCount + 13, 13) = "bp"
Hoja1.Cells(lnum.ListCount + 13, 14) = "tf"
Hoja1.Cells(lnum.ListCount + 13, 15) = "tw"
Hoja1.Cells(lnum.ListCount + 13, 16) = "AREA"
Hoja1.Cells(lnum.ListCount + 13, 17) = "I2"
Hoja1.Cells(lnum.ListCount + 13, 18) = "I3"

Hoja1.Cells(lnum.ListCount + 13, 19) = "J"
Hoja1.Cells(lnum.ListCount + 13, 20) = "ROT"
Hoja1.Cells(lnum.ListCount + 13, 21) = "LONG"

For i = e + 10 To e + 13
For j = 2 To 21
Hoja1.Cells(i, j).Font.Bold = True
Next
Next
For i = e + 12 To e + 13 + a
For j = 2 To 21
Hoja1.Cells(i, j).Borders.LineStyle = 1
Next
Next

For i = 1 To a
Hoja1.Cells(i + e + 13, 2) = lsne(i)

'MANDA EL NUMERO DE ELEMENTO

Next
For i = 1 To a
Hoja1.Cells(i + e + 13, 3) = lsi(i)

'MANDA EL VALOR DE "i"

Next
For i = 1 To a
Hoja1.Cells(i + e + 13, 4) = lsj(i)

'MANDA EL VALOR DE "j"

Next
For i = 1 To a
Hoja1.Cells(i + e + 13, 5) = lstip(i)

'MANDA EL TIPO DE ELEMENTO

Next
For i = 1 To a
Hoja1.Cells(i + e + 13, 6) = lse(i)

'MANDA EL MODULO DE ELASTICIDAD

Next
For i = 1 To a

Hoja1.Cells(i + e + 13, 7) = lsg(i)

'MANDA EL MODULO DE CORTE

Next
For i = 1 To a
Hoja1.Cells(i + e + 13, 8) = lsu(i)

'MANDA EL MODULO DE POISSON

Next
For i = 1 To a
Hoja1.Cells(i + e + 13, 9) = lsb(i)

'MANDA LA BASE DEL ELEMENTO

Next
For i = 1 To a
Hoja1.Cells(i + e + 13, 10) = lsh(i)

'MANDA LA ALTURA DEL ELEMENTO

Next
For i = 1 To a
Hoja1.Cells(i + e + 13, 11) = lsd(i)

'MANDA EL DIAMETRO DEL ELEMENTO

Next
For i = 1 To a
Hoja1.Cells(i + e + 13, 12) = lshp(i)

'MANDA EL hp DEL PERFIL

Next
For i = 1 To a
Hoja1.Cells(i + e + 13, 13) = lsbp(i)

'MANDA EL bp DEL PERFIL

Next
For i = 1 To a
Hoja1.Cells(i + e + 13, 14) = lstf(i)

'MANDA EL tf DEL PERFIL

Next
For i = 1 To a
Hoja1.Cells(i + e + 13, 15) = lstw(i)
Next

'MANDA EL tw DEL PERFIL

For i = 1 To a
Hoja1.Cells(i + e + 13, 16) = lsarea(i)

'MANDA EL VALOR DEL AREA

Next
For i = 1 To a
Hoja1.Cells(i + e + 13, 17) = lin2(i)

'MANDA LA INERCIA EN 2

Next
For i = 1 To a
Hoja1.Cells(i + e + 13, 18) = lin3(i)

'MANDA LA INERCIA EN 3

Next
For i = 1 To a
Hoja1.Cells(i + e + 13, 19) = linj(i)

'MANDA LA INERCIA POLAR

Next
For i = 1 To d
'ASIGNA EL ANGULO DE ROTACION SOLO A
LOS ELEMENTOS QUE LES CORRESPONDE
b = lser(i)
Hoja1.Cells(b + e + 13, 20) = lsa(i)
Next

'XXXXX LISTA DE LONGITUDES Y VECTORES UNITARIOS U1 XXXXX

a = lnu.ListCount
ReDim lmod(1 To a) As Double
ReDim u1x(1 To a) As Double
ReDim u1y(1 To a) As Double
ReDim u1z(1 To a) As Double
For k = 1 To a
d = lsi(k)
e = lsj(k)
X = lsx(e) - lsx(d)

Y = lsy(e) - lsy(d)
z = lsz(e) - lsz(d)
lmod(k) = (X ^ 2 + Y ^ 2 + z ^ 2) ^ 0.5
u1x(k) = X / lmod(k)
u1y(k) = Y / lmod(k)
u1z(k) = z / lmod(k)
Next

For i = 1 To a
Hoja1.Cells(i + e + 13, 21) = lmod(i)

'MANDA LA longitud

Hoja6.Cells(i + 8, 71) = lmod(i)
Next

'XXXXX CARGAR MATRIZ DE RIGIDEZ XXXXX

r = lnum.ListCount + 6 * lnu.ListCount
'LA POSICION ES EN FUNCION DE TRES
VECES NUMERO DE ELEMENTOS MAS NUMERO DE NUDOS
For k = 0 To lnu.ListCount - 1
Hoja1.Cells(r + 17 + 15 * k, 3) = "MATRIZ DE RIGIDEZ DEL ELEMENTO"
Hoja1.Cells(r + 17 + 15 * k, 6) = lsne(k + 1)
For i = (r + 19 + 15 * k) To r + 30 + 15 * k
For j = 2 To 13
Hoja1.Cells(i, j) = 0
Next
Next

'XXXXX RIGIDECES EN CADA EJE DEL ELEMENTO XXXXX

s(1) = lse(k + 1) * lsarea(k + 1) / lmod(k + 1)
s(2) = 12 * lse(k + 1) * lin3(k + 1) / lmod(k + 1) ^ 3
s(3) = 12 * lse(k + 1) * lin2(k + 1) / lmod(k + 1) ^ 3
s(4) = lsg(k + 1) * linj(k + 1) / lmod(k + 1)
s(5) = 4 * lse(k + 1) * lin2(k + 1) / lmod(k + 1)
s(6) = 4 * lse(k + 1) * lin3(k + 1) / lmod(k + 1)
s(7) = 6 * lse(k + 1) * lin2(k + 1) / lmod(k + 1) ^ 2
s(8) = 6 * lse(k + 1) * lin3(k + 1) / lmod(k + 1) ^ 2
s(9) = 2 * lse(k + 1) * lin2(k + 1) / lmod(k + 1)
s(10) = 2 * lse(k + 1) * lin3(k + 1) / lmod(k + 1)
Hoja1.Cells(r + 19 + 15 * k, 2) = s(1)
Hoja1.Cells(r + 25 + 15 * k, 2) = -s(1)
Hoja1.Cells(r + 20 + 15 * k, 3) = s(2)
Hoja1.Cells(r + 24 + 15 * k, 3) = s(8)
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
Hoja1.Cells(r + 26 + 15 * k, 3) = -s(2)
Hoja1.Cells(r + 30 + 15 * k, 3) = s(8)
Hoja1.Cells(r + 21 + 15 * k, 4) = s(3)
Hoja1.Cells(r + 23 + 15 * k, 4) = -s(7)
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
Hoja1.Cells(r + 27 + 15 * k, 4) = -s(3)
Hoja1.Cells(r + 29 + 15 * k, 4) = -s(7)
Hoja1.Cells(r + 22 + 15 * k, 5) = s(4)
Hoja1.Cells(r + 28 + 15 * k, 5) = -s(4)
Hoja1.Cells(r + 21 + 15 * k, 6) = -s(7)
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
Hoja1.Cells(r + 23 + 15 * k, 6) = s(5)
Hoja1.Cells(r + 27 + 15 * k, 6) = s(7)
Hoja1.Cells(r + 29 + 15 * k, 6) = s(9)

Hoja1.Cells(r + 20 + 15 * k, 7) = s(8)
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
Hoja1.Cells(r + 24 + 15 * k, 7) = s(6)
Hoja1.Cells(r + 26 + 15 * k, 7) = -s(8)
Hoja1.Cells(r + 30 + 15 * k, 7) = s(10)
Hoja1.Cells(r + 19 + 15 * k, 8) = -s(1)
Hoja1.Cells(r + 25 + 15 * k, 8) = s(1)
Hoja1.Cells(r + 20 + 15 * k, 9) = -s(2)
Hoja1.Cells(r + 24 + 15 * k, 9) = -s(8)
Hoja1.Cells(r + 26 + 15 * k, 9) = s(2)
Hoja1.Cells(r + 30 + 15 * k, 9) = -s(8)
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
Hoja1.Cells(r + 21 + 15 * k, 10) = -s(3)
Hoja1.Cells(r + 23 + 15 * k, 10) = s(7)
Hoja1.Cells(r + 27 + 15 * k, 10) = s(3)
Hoja1.Cells(r + 29 + 15 * k, 10) = s(7)
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
Hoja1.Cells(r + 22 + 15 * k, 11) = -s(4)
Hoja1.Cells(r + 28 + 15 * k, 11) = s(4)
Hoja1.Cells(r + 21 + 15 * k, 12) = -s(7)
Hoja1.Cells(r + 23 + 15 * k, 12) = s(9)
Hoja1.Cells(r + 27 + 15 * k, 12) = s(7)
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
Hoja1.Cells(r + 29 + 15 * k, 12) = s(5)
Hoja1.Cells(r + 20 + 15 * k, 13) = s(8)
Hoja1.Cells(r + 24 + 15 * k, 13) = s(10)
Hoja1.Cells(r + 26 + 15 * k, 13) = -s(8)
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
Hoja1.Cells(r + 30 + 15 * k, 13) = s(6)

'XXXXX BORDES DE MATRIZ XXXXX

For i = r + 19 + 15 * k To r + 30 + 15 * k

'BORDE IZQUIERDO

Hoja1.Cells(i, 2).Select
With Selection
.Borders(xlEdgeLeft).LineStyle = 12
End With
Next

For i = r + 19 + 15 * k To r + 30 + 15 * k
Hoja1.Cells(i, 13).Select
With Selection
.Borders(xlEdgeRight).LineStyle = 12
End With
Next

For i = r + 19 + 15 * k To r + 30 + 15 * k
Hoja1.Cells(i, 7).Select
With Selection
.Borders(xlEdgeRight).LineStyle = 10
End With
Next

For i = 2 To 13
Hoja1.Cells(r + 25 + 15 * k, i).Select
With Selection
.Borders(xlEdgeTop).LineStyle = 10
End With
Next

Next

'BORDE DERECHO

End Sub

'________________________________ MATRIZ DE TRANSFORMACION
____________________________________________________

Private Sub bttran_Click()

Application.ScreenUpdating = False

'XXXXX GENERAR LA MATRIZ DE TRANSFORMACION XXXXX

r = lnum.ListCount + 6 * lnu.ListCount
'LA POSICION ES EN FUNCION DE TRES
VECES NUMERO DE ELEMENTOS MAS NUMERO DE NUDOS
For k = 0 To lnu.ListCount - 1
Hoja1.Cells(r + 17 + 15 * k, 20) = "MATRIZ DE TRANSFORMACION DEL
ELEMENTO"
Hoja1.Cells(r + 17 + 15 * k, 23) = lsne(k + 1)
For i = (r + 19 + 15 * k) To r + 30 + 15 * k
For j = 18 To 29
Hoja1.Cells(i, j) = 0
Next
Next
For i = 0 To 3
Hoja1.Cells(r + 19 + 15 * k + 3 * i, 18 + 3 * i) = Round(u1x(k + 1), 6)
Hoja1.Cells(r + 19 + 15 * k + 3 * i, 19 + 3 * i) = Round(u1y(k + 1), 6)
Hoja1.Cells(r + 19 + 15 * k + 3 * i, 20 + 3 * i) = Round(u1z(k + 1), 6)
Hoja1.Cells(r + 20 + 15 * k + 3 * i, 18 + 3 * i) = Round(u2x(k + 1) * Cos(aux(k + 1) *
3.14159265359 / 180) + u3x(k + 1) * Sin(aux(k + 1) * 3.14159265359 / 180), 6)
Hoja1.Cells(r + 20 + 15 * k + 3 * i, 19 + 3 * i) = Round(u2y(k + 1) * Cos(aux(k + 1) *
3.14159265359 / 180) + u3y(k + 1) * Sin(aux(k + 1) * 3.14159265359 / 180), 6)

Hoja1.Cells(r + 20 + 15 * k + 3 * i, 20 + 3 * i) = Round(u2z(k + 1) * Cos(aux(k + 1) *
3.14159265359 / 180) + u3z(k + 1) * Sin(aux(k + 1) * 3.14159265359 / 180), 6)
Hoja1.Cells(r + 21 + 15 * k + 3 * i, 18 + 3 * i) = Round(-u2x(k + 1) * Sin(aux(k + 1) *
3.14159265359 / 180) + u3x(k + 1) * Cos(aux(k + 1) * 3.14159265359 / 180), 6)
Hoja1.Cells(r + 21 + 15 * k + 3 * i, 19 + 3 * i) = Round(-u2y(k + 1) * Sin(aux(k + 1) *
3.14159265359 / 180) + u3y(k + 1) * Cos(aux(k + 1) * 3.14159265359 / 180), 6)
Hoja1.Cells(r + 21 + 15 * k + 3 * i, 20 + 3 * i) = Round(-u2z(k + 1) * Sin(aux(k + 1) *
3.14159265359 / 180) + u3z(k + 1) * Cos(aux(k + 1) * 3.14159265359 / 180), 6)
Next

'XXXXX BORDES DE MATRIZ XXXXX
For i = r + 19 + 15 * k To r + 31 + 15 * k
Hoja1.Cells(i, 18).Select
With Selection
.Borders(xlEdgeLeft).LineStyle = 12
End With
Next

For i = r + 19 + 15 * k To r + 31 + 15 * k
Hoja1.Cells(i, 29).Select
With Selection
.Borders(xlEdgeRight).LineStyle = 12
End With
Next

For i = r + 19 + 15 * k To r + 30 + 15 * k

Hoja1.Cells(i, 20).Select
With Selection
.Borders(xlEdgeRight).LineStyle = 10

'BORDES INTERNOS VERTICALES

End With
Hoja1.Cells(i, 23).Select
With Selection
.Borders(xlEdgeRight).LineStyle = 10
End With
Hoja1.Cells(i, 26).Select
With Selection
.Borders(xlEdgeRight).LineStyle = 10
End With

Next

For i = 18 To 29

'BORDES INTERNOS HORIZONTALES

Hoja1.Cells(r + 22 + 15 * k, i).Select
With Selection
.Borders(xlEdgeTop).LineStyle = 10
End With
Hoja1.Cells(r + 25 + 15 * k, i).Select
With Selection
.Borders(xlEdgeTop).LineStyle = 10
End With
Hoja1.Cells(r + 28 + 15 * k, i).Select
With Selection
.Borders(xlEdgeTop).LineStyle = 10
End With

Next
Next

'XXXXX GENERAR LA MATRIZ DE TRANSFORMACION TRANSPUESTA XXXXX

r = lnum.ListCount + 6 * lnu.ListCount
'LA POSICION ES EN FUNCION DE TRES
VECES NUMERO DE ELEMENTOS MAS NUMERO DE NUDOS
For k = 0 To lnu.ListCount - 1
Hoja1.Cells(r + 17 + 15 * k, 34) = "MATRIZ TRANSPUESTA DEL ELEMENTO"
Hoja1.Cells(r + 17 + 15 * k, 37) = lsne(k + 1)
For i = (r + 19 + 15 * k) To r + 30 + 15 * k
For j = 32 To 43
Hoja1.Cells(i, j) = 0
Next
Next
For i = 0 To 3
Hoja1.Cells(r + 19 + 15 * k + 3 * i, 32 + 3 * i) = Round(u1x(k + 1), 6) '1.1
Hoja1.Cells(r + 19 + 15 * k + 3 * i, 33 + 3 * i) = Round(u2x(k + 1) * Cos(aux(k + 1) *
3.14159265359 / 180) + u3x(k + 1) * Sin(aux(k + 1) * 3.14159265359 / 180), 6) '1.2
Hoja1.Cells(r + 19 + 15 * k + 3 * i, 34 + 3 * i) = Round(-u2x(k + 1) * Sin(aux(k + 1) *
3.14159265359 / 180) + u3x(k + 1) * Cos(aux(k + 1) * 3.14159265359 / 180), 6) '1.3
Hoja1.Cells(r + 20 + 15 * k + 3 * i, 32 + 3 * i) = Round(u1y(k + 1), 6) '2.1
Hoja1.Cells(r + 20 + 15 * k + 3 * i, 33 + 3 * i) = Round(u2y(k + 1) * Cos(aux(k + 1) *
3.14159265359 / 180) + u3y(k + 1) * Sin(aux(k + 1) * 3.14159265359 / 180), 6) '2.2
Hoja1.Cells(r + 20 + 15 * k + 3 * i, 34 + 3 * i) = Round(-u2y(k + 1) * Sin(aux(k + 1) *
3.14159265359 / 180) + u3y(k + 1) * Cos(aux(k + 1) * 3.14159265359 / 180), 6) '2.3
Hoja1.Cells(r + 21 + 15 * k + 3 * i, 32 + 3 * i) = Round(u1z(k + 1), 6) '3.1
Hoja1.Cells(r + 21 + 15 * k + 3 * i, 33 + 3 * i) = Round(u2z(k + 1) * Cos(aux(k + 1) *
3.14159265359 / 180) + u3z(k + 1) * Sin(aux(k + 1) * 3.14159265359 / 180), 6) '3.2
Hoja1.Cells(r + 21 + 15 * k + 3 * i, 34 + 3 * i) = Round(-u2z(k + 1) * Sin(aux(k + 1) *
3.14159265359 / 180) + u3z(k + 1) * Cos(aux(k + 1) * 3.14159265359 / 180), 6) '3.3
Next

'XXXXX BORDES DE MATRIZ XXXXX
For i = r + 19 + 15 * k To r + 31 + 15 * k
Hoja1.Cells(i, 32).Select
With Selection
.Borders(xlEdgeLeft).LineStyle = 12
End With
Next

For i = r + 19 + 15 * k To r + 31 + 15 * k
Hoja1.Cells(i, 43).Select
With Selection
.Borders(xlEdgeRight).LineStyle = 12
End With
Next

For i = r + 19 + 15 * k To r + 30 + 15 * k

Hoja1.Cells(i, 34).Select
With Selection
.Borders(xlEdgeRight).LineStyle = 10
End With
Hoja1.Cells(i, 37).Select
With Selection
.Borders(xlEdgeRight).LineStyle = 10
End With
Hoja1.Cells(i, 40).Select
With Selection
.Borders(xlEdgeRight).LineStyle = 10
End With

'BORDES INTERNOS VERTICALES

Next

For i = 32 To 43

'BORDES INTERNOS HORIZONTALES

Hoja1.Cells(r + 22 + 15 * k, i).Select
With Selection
.Borders(xlEdgeTop).LineStyle = 10
End With
Hoja1.Cells(r + 25 + 15 * k, i).Select
With Selection
.Borders(xlEdgeTop).LineStyle = 10
End With
Hoja1.Cells(r + 28 + 15 * k, i).Select
With Selection
.Borders(xlEdgeTop).LineStyle = 10
End With

Next
Next
End Sub

'________________________________________ GENERAR LA MATRIZ DE RIGIDEZ
GLOBAL _______________________________________________-

Private Sub CommandButton8_Click()

Application.ScreenUpdating = False

r = lnum.ListCount + 6 * lnu.ListCount
'LA POSICION ES EN FUNCION DE TRES
VECES NUMERO DE ELEMENTOS MAS NUMERO DE NUDOS
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
xxxxxxx
'XXXXX REDIMENSIONAMIENTO DE MATRICES COMPLETAS XXXXX
ReDim mp(1 To lnum.ListCount * 6, 1 To lnum.ListCount * 6) As Double
ReDim mc(1 To lnum.ListCount * 6, 1 To lnum.ListCount * 6) As Double
For i = 1 To lnum.ListCount * 6
For j = 1 To lnum.ListCount * 6
mc(i, j) = 0
mp(i, j) = 0
Next
Next
'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
xxxxxxx
For k = 0 To lnu.ListCount - 1
Hoja1.Cells(r + 17 + 15 * k, 48) = "MATRIZ DE RIGIDEZ GLOBAL DE"
Hoja1.Cells(r + 17 + 15 * k, 51) = lsne(k + 1)
For i = 1 To 12
For j = 1 To 12
t(i, j) = 0
kl(i, j) = 0
tt(i, j) = 0
kg(i, j) = 0
prod(i, j) = 0
Next
Next
For i = 0 To 3
'XXX MATRIZ DE TRANSFORMACION XXX

t(1 + 3 * i, 1 + 3 * i) = Round(u1x(k + 1), 6)
t(1 + 3 * i, 2 + 3 * i) = Round(u1y(k + 1), 6)
t(1 + 3 * i, 3 + 3 * i) = Round(u1z(k + 1), 6)
t(2 + 3 * i, 1 + 3 * i) = Round(u2x(k + 1) * Cos(aux(k + 1) * 3.14159265359 / 180) +
u3x(k + 1) * Sin(aux(k + 1) * 3.14159265359 / 180), 6)
t(2 + 3 * i, 2 + 3 * i) = Round(u2y(k + 1) * Cos(aux(k + 1) * 3.14159265359 / 180) +
u3y(k + 1) * Sin(aux(k + 1) * 3.14159265359 / 180), 6)
t(2 + 3 * i, 3 + 3 * i) = Round(u2z(k + 1) * Cos(aux(k + 1) * 3.14159265359 / 180) +
u3z(k + 1) * Sin(aux(k + 1) * 3.14159265359 / 180), 6)
t(3 + 3 * i, 1 + 3 * i) = Round(-u2x(k + 1) * Sin(aux(k + 1) * 3.14159265359 / 180) +
u3x(k + 1) * Cos(aux(k + 1) * 3.14159265359 / 180), 6)
t(3 + 3 * i, 2 + 3 * i) = Round(-u2y(k + 1) * Sin(aux(k + 1) * 3.14159265359 / 180) +
u3y(k + 1) * Cos(aux(k + 1) * 3.14159265359 / 180), 6)
t(3 + 3 * i, 3 + 3 * i) = Round(-u2z(k + 1) * Sin(aux(k + 1) * 3.14159265359 / 180) +
u3z(k + 1) * Cos(aux(k + 1) * 3.14159265359 / 180), 6)

'XXX MATRIZ TRANSPUESTA XXX

tt(1 + 3 * i, 1 + 3 * i) = Round(u1x(k + 1), 6) '1.1
tt(1 + 3 * i, 2 + 3 * i) = Round(u2x(k + 1) * Cos(aux(k + 1) * 3.14159265359 / 180) +
u3x(k + 1) * Sin(aux(k + 1) * 3.14159265359 / 180), 6) '1.2
tt(1 + 3 * i, 3 + 3 * i) = Round(-u2x(k + 1) * Sin(aux(k + 1) * 3.14159265359 / 180) +
u3x(k + 1) * Cos(aux(k + 1) * 3.14159265359 / 180), 6) '1.3
tt(2 + 3 * i, 1 + 3 * i) = Round(u1y(k + 1), 6) '2.1
tt(2 + 3 * i, 2 + 3 * i) = Round(u2y(k + 1) * Cos(aux(k + 1) * 3.14159265359 / 180) +
u3y(k + 1) * Sin(aux(k + 1) * 3.14159265359 / 180), 6) '2.2
tt(2 + 3 * i, 3 + 3 * i) = Round(-u2y(k + 1) * Sin(aux(k + 1) * 3.14159265359 / 180) +
u3y(k + 1) * Cos(aux(k + 1) * 3.14159265359 / 180), 6) '2.3
tt(3 + 3 * i, 1 + 3 * i) = Round(u1z(k + 1), 6) '3.1
tt(3 + 3 * i, 2 + 3 * i) = Round(u2z(k + 1) * Cos(aux(k + 1) * 3.14159265359 / 180) +
u3z(k + 1) * Sin(aux(k + 1) * 3.14159265359 / 180), 6) '3.2
tt(3 + 3 * i, 3 + 3 * i) = Round(-u2z(k + 1) * Sin(aux(k + 1) * 3.14159265359 / 180) +
u3z(k + 1) * Cos(aux(k + 1) * 3.14159265359 / 180), 6)

Next

'XXX MATRIZ DE RIGIDEZ LOCAL XXX

s(1) = lse(k + 1) * lsarea(k + 1) / lmod(k + 1)
s(2) = 12 * lse(k + 1) * lin3(k + 1) / lmod(k + 1) ^ 3
s(3) = 12 * lse(k + 1) * lin2(k + 1) / lmod(k + 1) ^ 3
s(4) = lsg(k + 1) * linj(k + 1) / lmod(k + 1)
s(5) = 4 * lse(k + 1) * lin2(k + 1) / lmod(k + 1)
s(6) = 4 * lse(k + 1) * lin3(k + 1) / lmod(k + 1)
s(7) = 6 * lse(k + 1) * lin2(k + 1) / lmod(k + 1) ^ 2
s(8) = 6 * lse(k + 1) * lin3(k + 1) / lmod(k + 1) ^ 2
s(9) = 2 * lse(k + 1) * lin2(k + 1) / lmod(k + 1)
s(10) = 2 * lse(k + 1) * lin3(k + 1) / lmod(k + 1)
kl(1, 1) = s(1)
kl(7, 1) = -s(1)
kl(2, 2) = s(2)
kl(6, 2) = s(8)
kl(8, 2) = -s(2)
kl(12, 2) = s(8)
kl(3, 3) = s(3)
kl(5, 3) = -s(7)
kl(9, 3) = -s(3)
kl(11, 3) = -s(7)
kl(4, 4) = s(4)
kl(10, 4) = -s(4)
kl(3, 5) = -s(7)
kl(5, 5) = s(5)

kl(9, 5) = s(7)
kl(11, 5) = s(9)
kl(2, 6) = s(8)
kl(6, 6) = s(6)
kl(8, 6) = -s(8)
kl(12, 6) = s(10)
kl(1, 7) = -s(1)
kl(7, 7) = s(1)
kl(2, 8) = -s(2)
kl(6, 8) = -s(8)
kl(8, 8) = s(2)
kl(12, 8) = -s(8)
kl(3, 9) = -s(3)
kl(5, 9) = s(7)
kl(9, 9) = s(3)
kl(11, 9) = s(7)
kl(4, 10) = -s(4)
kl(10, 10) = s(4)
kl(3, 11) = -s(7)
kl(5, 11) = s(9)
kl(9, 11) = s(7)
kl(11, 11) = s(5)
kl(2, 12) = s(8)
kl(6, 12) = s(10)
kl(8, 12) = -s(8)
kl(12, 12) = s(6)

suma = 0

For i = 1 To 12
For j = 1 To 12
For l = 1 To 12
suma = tt(i, l) * kl(l, j) + suma
Next
prod(i, j) = suma
suma = 0
Next
Next

suma = 0

For i = 1 To 12
For j = 1 To 12
For l = 1 To 12
suma = prod(i, l) * t(l, j) + suma
Next
kg(i, j) = suma
suma = 0
Next
Next

'XXXXX LLEVAR LA MATRIZ DE RIGIDEZ GLOBAL AL EXCEL XXXXX
For i = r + 19 + 15 * k To r + 30 + 15 * k
For j = 46 To 57
Hoja1.Cells(i, j) = kg(i - (18 + r + 15 * k), j - 45)
Next
Next

'XXXXX COLOCAR LA NUMERACION A LAS MATRICES XXXXX
For l = 46 To 51
Hoja1.Cells(r + 18 + 15 * k, l) = (lsi(k + 1) - 1) * 6 + l - 45
Hoja1.Cells(r + 18 + 15 * k, l).Select
With Selection
.Font.Bold = True
.Font.Size = 9
End With
Next
For l = 52 To 57
Hoja1.Cells(r + 18 + 15 * k, l) = (lsj(k + 1) - 1) * 6 + l - 51
Hoja1.Cells(r + 18 + 15 * k, l).Select
With Selection
.Font.Bold = True
.Font.Size = 9
End With
Next
For l = r + 19 + 15 * k To r + 24 + 15 * k
Hoja1.Cells(l, 45) = (lsi(k + 1) - 1) * 6 + 1 + l - (r + 19 + 15 * k)
Hoja1.Cells(l, 45).Select
With Selection
.Font.Bold = True
.Font.Size = 9
End With
Next
For l = r + 25 + 15 * k To r + 30 + 15 * k
Hoja1.Cells(l, 45) = (lsj(k + 1) - 1) * 6 + 1 + l - (r + 25 + 15 * k)
Hoja1.Cells(l, 45).Select
With Selection

.Font.Bold = True
.Font.Size = 9
End With
Next

'XXXXX PONER MARCO A LA MATRIZ GLOBAL XXXXX
For i = r + 19 + 15 * k To r + 30 + 15 * k
Hoja1.Cells(i, 45).Select
With Selection
.Borders(xlEdgeRight).LineStyle = 12
End With
Hoja1.Cells(i, 57).Select
With Selection
.Borders(xlEdgeRight).LineStyle = 12
End With
Hoja1.Cells(i, 51).Select
With Selection
.Borders(xlEdgeRight).LineStyle = 4
End With
Next
For i = 46 To 57
Hoja1.Cells(r + 24 + 15 * k, i).Select
With Selection
.Borders(xlEdgeBottom).LineStyle = 4
End With
Next

'XXXXX CREACIÓN DE LA MATRIZ DE RIGIDEZ COMPLETA XXXXX
For l = (lsi(k + 1) - 1) * 6 + 1 To lsi(k + 1) * 6

For m = (lsi(k + 1) - 1) * 6 + 1 To lsi(k + 1) * 6
a = l - (lsi(k + 1) - 1) * 6
b = m - (lsi(k + 1) - 1) * 6
mp(l, m) = kg(a, b)
Next
Next
For l = (lsi(k + 1) - 1) * 6 + 1 To lsi(k + 1) * 6
For m = (lsj(k + 1) - 1) * 6 + 1 To lsj(k + 1) * 6
a = l - (lsi(k + 1) - 1) * 6
b = m - (lsj(k + 1) - 1) * 6 + 6
mp(l, m) = kg(a, b)
mp(m, l) = kg(b, a)
Next
Next
For l = (lsj(k + 1) - 1) * 6 + 1 To lsj(k + 1) * 6
For m = (lsj(k + 1) - 1) * 6 + 1 To lsj(k + 1) * 6
a = l - (lsj(k + 1) - 1) * 6 + 6
b = m - (lsj(k + 1) - 1) * 6 + 6
mp(l, m) = kg(a, b)
Next
Next
For i = 1 To lnum.ListCount * 6
For j = 1 To lnum.ListCount * 6
mc(i, j) = mp(i, j) + mc(i, j)
Next
Next
For i = 1 To lnum.ListCount * 6
For j = 1 To lnum.ListCount * 6
mp(i, j) = 0

Next
Next

Next
End Sub

'_________________________ MATRIZ DE RIGIDEZ ENSAMBLADA EN EL EXCEL
___________________

Private Sub CommandButton10_Click()

Application.ScreenUpdating = False
'XXXXX LLEVAR MATRIZ ENSAMBLADA AL EXCEL XXXXX
For i = 5 To 5 + lnum.ListCount * 6 - 1
For j = 60 To 60 + lnum.ListCount * 6 - 1
Hoja1.Cells(i, j) = mc(i - 4, j - 59)
Next
Next

'XXXXX COLOCAR MARCO A LA MATRIZ ENSAMBLADA XXXXX
For i = 5 To 5 + lnum.ListCount * 6 - 1
Hoja1.Cells(i, 60).Select
With Selection
.Borders(xlEdgeLeft).LineStyle = 12
End With
Next
For i = 5 To 5 + lnum.ListCount * 6 - 1
Hoja1.Cells(i, 60 + lnum.ListCount * 6 - 1).Select
With Selection

.Borders(xlEdgeRight).LineStyle = 12
End With
Next

'XXXXX NUMERACION DE MATRIZ COMPLETA XXXXX
For l = 60 To lnum.ListCount * 6 + 59
Hoja1.Cells(4, l) = l - 59
Hoja1.Cells(4, l).Select
With Selection
.Font.Bold = True
End With
Next
For l = 5 To lnum.ListCount * 6 + 4
Hoja1.Cells(l, 59) = l - 4
Hoja1.Cells(l, 59).Select
With Selection
.Font.Bold = True
End With
Next

End Sub

'_________________________ VECTORES UNITARIOS
_________________________________________

Private Sub btvec_Click()

Application.ScreenUpdating = False

'XXXXX CARGAR ROTULOS XXXXX
Hoja1.Cells(4, 26) = "VECTORES POR DEFECTO"
Hoja1.Cells(4, 33) = "VECTORES ROTADOS"
Hoja1.Cells(5, 24) = "ELEMENTO"
Hoja1.Cells(5, 25) = "VECTOR"
Hoja1.Cells(6, 25) = "UNITARIO"
Hoja1.Cells(5, 27) = "COORDENADAS"
Hoja1.Cells(6, 26) = "X"
Hoja1.Cells(6, 27) = "Y"
Hoja1.Cells(6, 28) = "Z"
Hoja1.Cells(5, 30) = "ELEMENTO"
Hoja1.Cells(5, 31) = "ANGULO"
Hoja1.Cells(6, 31) = "ROTADO"
Hoja1.Cells(5, 32) = "VECTOR"
Hoja1.Cells(6, 32) = "UNITARIO"
Hoja1.Cells(5, 34) = "COORDENADAS"
Hoja1.Cells(6, 33) = "X"
Hoja1.Cells(6, 34) = "Y"
Hoja1.Cells(6, 35) = "Z"

'XXXXX REDIMENSIONAR MATRICES DE VECTORES XXXXX
a = lnu.ListCount
ReDim u2x(a) As Double
ReDim u2y(a) As Double
ReDim u2z(a) As Double
ReDim u3x(a) As Double
ReDim u3y(a) As Double
ReDim u3z(a) As Double

'XXXXX CREACION DE UNITARIOS U2 U3 XXXXX

For k = 1 To a
'XXX CUANDO SE TRABAJA CON VIGAS XXX
If lstip(k) = 1 Then
r = (u1y(k) ^ 2 + u1x(k) ^ 2) ^ 0.5
u3x(k) = u1y(k) / r
u3y(k) = -u1x(k) / r
u3z(k) = 0
u2x(k) = u3y(k) * u1z(k) - u1y(k) * u3z(k)
u2y(k) = u1x(k) * u3z(k) - u3x(k) * u1z(k)
u2z(k) = u3x(k) * u1y(k) - u1x(k) * u3y(k)
End If

'XXX CUANDO SE TRABAJA CON COLUMNAS XXX
If lstip(k) = 2 Then
r = (u1y(k) ^ 2 + u1z(k) ^ 2) ^ 0.5
u3x(k) = 0
u3y(k) = u1z(k) / r
u3z(k) = u1y(k) / r
u2x(k) = u3y(k) * u1z(k) - u1y(k) * u3z(k)
u2y(k) = u1x(k) * u3z(k) - u3x(k) * u1z(k)
u2z(k) = u3x(k) * u1y(k) - u1x(k) * u3y(k)
End If
Next

'XXXXX CARGAR LAS COMPONENTES DE LOS UNITARIOS A EXCELL XXXXX
For k = 1 To a

Hoja1.Cells(4 + 3 * k, 25) = "u1"
Hoja1.Cells(4 + 3 * k, 26) = u1x(k)
Hoja1.Cells(4 + 3 * k, 27) = u1y(k)
Hoja1.Cells(4 + 3 * k, 28) = u1z(k)
Hoja1.Cells(5 + 3 * k, 25) = "u2"
Hoja1.Cells(5 + 3 * k, 26) = u2x(k)
Hoja1.Cells(5 + 3 * k, 27) = u2y(k)
Hoja1.Cells(5 + 3 * k, 28) = u2z(k)
Hoja1.Cells(6 + 3 * k, 25) = "u3"
Hoja1.Cells(6 + 3 * k, 26) = u3x(k)
Hoja1.Cells(6 + 3 * k, 27) = u3y(k)
Hoja1.Cells(6 + 3 * k, 28) = u3z(k)
Hoja1.Cells(5 + 3 * k, 24) = lsne(k)
Next

'XXXXX ANGULOS DE ROTACION XXXXX
ReDim aux(1 To lnu.ListCount) As Double
For i = 1 To lnu.ListCount
aux(i) = 0
Next
d = lelem.ListCount
For i = 1 To d
aux(lser(i)) = lsa(i)
Next

'XXXXX VECTORES UNITARIOS ROTADOS XXXXX
For k = 1 To a
Hoja1.Cells(4 + 3 * k, 32) = "u1"
Hoja1.Cells(4 + 3 * k, 33) = u1x(k)

Hoja1.Cells(4 + 3 * k, 34) = u1y(k)
Hoja1.Cells(4 + 3 * k, 35) = u1z(k)
Hoja1.Cells(5 + 3 * k, 32) = "u2"
Hoja1.Cells(5 + 3 * k, 33) = u2x(k) * Cos(aux(k) * 3.14159265359 / 180) + u3x(k) *
Sin(aux(k) * 3.14159265359 / 180)
Hoja1.Cells(5 + 3 * k, 34) = u2y(k) * Cos(aux(k) * 3.14159265359 / 180) + u3y(k) *
Sin(aux(k) * 3.14159265359 / 180)
Hoja1.Cells(5 + 3 * k, 35) = u2z(k) * Cos(aux(k) * 3.14159265359 / 180) + u3z(k) *
Sin(aux(k) * 3.14159265359 / 180)
Hoja1.Cells(6 + 3 * k, 32) = "u3"
Hoja1.Cells(6 + 3 * k, 33) = -u2x(k) * Sin(aux(k) * 3.14159265359 / 180) + u3x(k) *
Cos(aux(k) * 3.14159265359 / 180)
Hoja1.Cells(6 + 3 * k, 34) = -u2y(k) * Sin(aux(k) * 3.14159265359 / 180) + u3y(k) *
Cos(aux(k) * 3.14159265359 / 180)
Hoja1.Cells(6 + 3 * k, 35) = -u2z(k) * Sin(aux(k) * 3.14159265359 / 180) + u3z(k) *
Cos(aux(k) * 3.14159265359 / 180)
Hoja1.Cells(5 + 3 * k, 30) = lsne(k)
Hoja1.Cells(5 + 3 * k, 31) = aux(k)
Next

'XXXXX PONER CUADRO A LOS DATOS XXXXX
For i = 4 To 6 + 3 * a
For j = 24 To 28
Hoja1.Cells(i, j).Select
With Selection
.Borders.LineStyle = 1
End With
Next
Next
For i = 4 To 6 + 3 * a
For j = 30 To 35

Hoja1.Cells(i, j).Select
With Selection
.Borders.LineStyle = 1
End With
Next
Next

End Sub

'_____________________________CREAR LA MATRIZ REORDENADA
____________________________________

Private Sub CommandButton13_Click() 'botón "MATRIZ REORDENADA"

Application.ScreenUpdating = False
'XXXXX CREAR MATRIZ DE CEROS PARA LA MATRIZ REORDENADA XXXXX
ReDim mr(1 To 6 * lnum.ListCount, 1 To 6 * lnum.ListCount) As Double
nx = 6 * lnum.ListCount
ESTRUCTURA

'NÚMERO TOTAL DE COORDENADAS EN LA

For i = 1 To lnum.ListCount
For j = 1 To lnum.ListCount
mr(i, j) = 0
Next
Next

'XXXXX CREAR LA MATRIZ DE LAS CONDICIONES INICIALES DE LOS APOYOS
XXXXX
ReDim lapoy(1 To UserForm2.lstdn.ListCount, 1 To 7) As Double
For i = 1 To UserForm2.lstdn.ListCount
lapoy(i, 1) = UserForm2.lstdn.List(i - 1)

lapoy(i, 2) = UserForm2.lstdx.List(i - 1)
lapoy(i, 3) = UserForm2.lstdy.List(i - 1)
lapoy(i, 4) = UserForm2.lstdz.List(i - 1)
lapoy(i, 5) = UserForm2.lstgx.List(i - 1)
lapoy(i, 6) = UserForm2.lstgy.List(i - 1)
lapoy(i, 7) = UserForm2.lstgz.List(i - 1)
Next

'XXXXX PARA CREAR LA MATRIZ Qot EN SCG XXXXX
ReDim Qot(1 To lnum.ListCount, 1 To 7) As Double
For i = 1 To lnum.ListCount
Qot(i, 1) = i
For j = 2 To 7
Qot(i, j) = 0
Next
Next

'XXXXX PARA CARGAR LOS DATOS DE LAS CARGAS PUNTUALES SI LAS HAY
XXXXX
aux1 = UserForm2.lstfx.ListCount
If aux1 > 0 Then
For i = 1 To aux1
For j = 1 To lnum.ListCount
If UserForm2.lstfn.List(i - 1) = Qot(j, 1) Then
Qot(j, 2) = UserForm2.lstfx.List(i - 1)
Qot(j, 3) = UserForm2.lstfy.List(i - 1)
Qot(j, 4) = UserForm2.lstfz.List(i - 1)
Qot(j, 5) = UserForm2.lstmx.List(i - 1)
Qot(j, 6) = UserForm2.lstmy.List(i - 1)

Qot(j, 7) = UserForm2.lstmz.List(i - 1)
End If
Next
Next
End If

'XXXXX PARA COLOCAR LOS DATOS DE LAS CARGAS DISTRIBUIDAS EN LOS
ELEMENTOS XXXXX
For i = 1 To 12
For j = 1 To 12
tt(i, j) = 0
Next
Next
If UserForm4.lstel.ListCount > 0 Then
For i = 1 To UserForm4.lstel.ListCount
For j = 1 To lnu.ListCount
If UserForm4.lstel.List(i - 1) = lnu.List(j - 1) Then
'XXX HACER CEROS LA MATRIZ DE CARGAS EQUIV EN SCG (Qoe) XXX
For k = 1 To 12
Qoe(k) = 0
Next

'XXX GENERAR TT PARA CADA ELEMENTO XXX
For k = 0 To 3
tt(1 + 3 * k, 1 + 3 * k) = u1x(j)
tt(2 + 3 * k, 1 + 3 * k) = u1y(j)
tt(3 + 3 * k, 1 + 3 * k) = u1z(j)
tt(1 + 3 * k, 2 + 3 * k) = u2x(j) * Cos(aux(j) * 3.14159 / 180) + u3x(j) *
Sin(aux(j) * 3.14159 / 180)

tt(2 + 3 * k, 2 + 3 * k) = u2y(j) * Cos(aux(j) * 3.14159 / 180) + u3y(j) *
Sin(aux(j) * 3.14159 / 180)
tt(3 + 3 * k, 2 + 3 * k) = u2z(j) * Cos(aux(j) * 3.14159 / 180) + u3z(j) *
Sin(aux(j) * 3.14159 / 180)
tt(1 + 3 * k, 3 + 3 * k) = -u2x(j) * Sin(aux(j) * 3.14159 / 180) + u3x(j) *
Cos(aux(j) * 3.14159 / 180)
tt(2 + 3 * k, 3 + 3 * k) = -u2y(j) * Sin(aux(j) * 3.14159 / 180) + u3y(j) *
Cos(aux(j) * 3.14159 / 180)
tt(3 + 3 * k, 3 + 3 * k) = -u2z(j) * Sin(aux(j) * 3.14159 / 180) + u3z(j) *
Cos(aux(j) * 3.14159 / 180)
Next

'XXX CREAR EL VECTOR DE CARGAS qe XXX
qe(1) = UserForm4.lstq1.List(i - 1)
qe(2) = UserForm4.lstq2.List(i - 1)
qe(3) = UserForm4.lstq3.List(i - 1)
qe(4) = UserForm4.lstq4.List(i - 1)
qe(5) = UserForm4.lstq5.List(i - 1)
qe(6) = UserForm4.lstq6.List(i - 1)
qe(7) = UserForm4.lstq7.List(i - 1)
qe(8) = UserForm4.lstq8.List(i - 1)
qe(9) = UserForm4.lstq9.List(i - 1)
qe(10) = UserForm4.lstq10.List(i - 1)
qe(11) = UserForm4.lstq11.List(i - 1)
qe(12) = UserForm4.lstq12.List(i - 1)

'XXX PASAR EL VECTOR qe AL SISTEMA GLOBAL DE COORDENADAS
XXX
For k = 1 To 12
For l = 1 To 12
Qoe(k) = tt(k, l) * qe(l) + Qoe(k)

Next
Next

'XXX SUMAR LAS CARGAS EN EL SISTEMA GLOBAL A LA MATRIZ DE
CARGAS EN LOS NUDOS SGC XXX
aux1 = UserForm4.lstel.List(i - 1)
aux2 = UserForm4.lstel.List(i - 1)
For l = 2 To 7
Qot(lsi(aux1), l) = Qoe(l - 1) + Qot(lsi(aux1), l)
Qot(lsj(aux2), l) = Qoe(l + 5) + Qot(lsj(aux2), l)
Next
End If
Next
Next
End If

'XXXXX SEPARANDO LOS NUDOS LIBRES DE LOS APOYOS XXXXX
ReDim auxx1(1 To lnum.ListCount)
For i = 1 To lnum.ListCount
auxx1(i) = i
Next
For i = 1 To UserForm2.lstdn.ListCount
For j = 1 To lnum.ListCount
If UserForm2.lstdn.List(i - 1) = lnum.List(j - 1) Then
auxx1(j) = 0
End If
Next
Next

'XXX CREA MATRIX COLUMNA SÓLO DE LOS NUDOS LIBRES XXX
ReDim auxx2(1 To lnum.ListCount - UserForm2.lstdn.ListCount)
aux1 = 1
For i = 1 To lnum.ListCount
If auxx1(i) > 0 Then
auxx2(aux1) = auxx1(i)
aux1 = aux1 + 1
End If
Next

'XXXXX CREAR MATRIZ COLUMNA DE TODOS LOS APOYOS MÁS LA
NUMERACIÓN XXXXX
ReDim apoyo(1 To 6 * UserForm2.lstdn.ListCount, 2)
aux1 = 0
aux2 = 0
For i = 1 To UserForm2.lstdn.ListCount
For j = 1 To 6
apoyo(j + 6 * (i - 1), 1) = j + 6 * (lapoy(i, 1) - 1)
apoyo(j + 6 * (i - 1), 2) = lapoy(i, j + 1)
Next
Next
For i = 1 To 6 * UserForm2.lstdn.ListCount
If apoyo(i, 2) = 1000 Then
aux1 = aux1 + 1
Else
aux2 = aux2 + 1
End If
Next
'XXXXX MATRICES DE DES. CONOCIDOS Y DESCONOCIDOS XXXXX

ReDim ncon(aux2, 2) As Double
ReDim ndes(aux1, 2) As Double

'XXXXX PARA LOS VALORES CONOCIDOS XXXXX
ReDim auxx1(1 To 6 * UserForm2.lstdn.ListCount)
For i = 1 To 6 * UserForm2.lstdn.ListCount
auxx1(i) = 0
Next
For i = 1 To 6 * UserForm2.lstdn.ListCount
If apoyo(i, 2) = 1000 Then
auxx1(i) = 0
Else
auxx1(i) = apoyo(i, 1)
End If
Next

aux3 = 1
For i = 1 To 6 * UserForm2.lstdn.ListCount
If auxx1(i) > 0 Then
ncon(aux3, 1) = apoyo(i, 1)
ncon(aux3, 2) = apoyo(i, 2)
aux3 = aux3 + 1
End If
Next

'XXXXX PARA LOS VALORES DESCONOCIDOS XXXXX
ReDim auxx1(1 To 6 * UserForm2.lstdn.ListCount)
For i = 1 To 6 * UserForm2.lstdn.ListCount
auxx1(i) = 0

Next
For i = 1 To 6 * UserForm2.lstdn.ListCount
If apoyo(i, 2) < 1000 Then
auxx1(i) = 0
Else
auxx1(i) = apoyo(i, 1)
End If
Next

aux3 = 1
For i = 1 To 6 * UserForm2.lstdn.ListCount
If auxx1(i) > 0 Then
ndes(aux3, 1) = apoyo(i, 1)
aux3 = aux3 + 1
End If
Next

'XXXXX PARA COLOCAR TODOS LOS NUDOS DE DESP. DESCONOCIDOS XXXXX
ReDim auxx1(1 To 6 * lnum.ListCount)
For i = 1 To 6 * lnum.ListCount
auxx1(i) = i
Next
For i = 1 To aux1
auxx1(ndes(i, 1)) = 0
Next
For i = 1 To lnum.ListCount - UserForm2.lstdn.ListCount
For j = 1 To 6
auxx1(j + 6 * (auxx2(i) - 1)) = 0
Next

Next

co = aux1 + 6 * (lnum.ListCount - UserForm2.lstdn.ListCount)
cx = aux2

ReDim clibres(1 To co) As Double
aux3 = 1
For i = 1 To 6 * lnum.ListCount
If auxx1(i) = 0 Then
clibres(aux3) = i
aux3 = aux3 + 1
End If
Next

'XXXXX PARA CREAR LA MATRIZ REORDENADA XXXXX
'XXXXX PARA CREAR EL Koo XXXXX

For i = 1 To co
For j = 1 To co
mr(i, j) = mc(clibres(i), clibres(j))
Next
Next
'XXXXX PARA CREAR EL Kox y Kxo XXXXX
For i = 1 To co
For j = 1 To cx
mr(i, j + co) = mc(clibres(i), ncon(j, 1))
mr(j + co, i) = mc(ncon(j, 1), clibres(i))
Next

Next
'XXXXX PARA CREAR EL Kxx XXXXX
For i = 1 To cx
For j = 1 To cx
mr(i + co, j + co) = mc(ncon(i, 1), ncon(j, 1))
Next
Next

'XXXXX LLEVAR LA MATRIZ REORDENADA AL EXCEL XXXXX
For i = 5 To 4 + 6 * lnum.ListCount
For j = 62 + 6 * lnum.ListCount To 61 + 12 * lnum.ListCount
Hoja1.Cells(i, j) = mr(i - 4, j - (61 + 6 * lnum.ListCount))
Next
Next

'XXXXX NUMERACION DE MATRIZ REORDENADA XXXXX
'XXX NUMERACIÓN DE COLUMNAS XXX
For i = 1 To co
Hoja1.Cells(4, 62 + 6 * lnum.ListCount + i - 1) = clibres(i)
Hoja1.Cells(4, 62 + 6 * lnum.ListCount + i - 1).Select
With Selection
.Font.Bold = True
End With
Hoja1.Cells(4 + co, 62 + 6 * lnum.ListCount + i - 1).Select
With Selection
.Borders(xlEdgeBottom).LineStyle = 5
NUDOS LIBRES Y APOYOS
End With
Next

'PARA LÍNEA LÍMITE DE

For i = 1 To cx
Hoja1.Cells(4, 62 + 6 * lnum.ListCount + co - 1 + i) = ncon(i, 1)
Hoja1.Cells(4, 62 + 6 * lnum.ListCount + co - 1 + i).Select
With Selection
.Font.Bold = True
End With
Hoja1.Cells(4 + co, 62 + 6 * lnum.ListCount + co - 1 + i).Select
With Selection
.Borders(xlEdgeBottom).LineStyle = 5
NUDOS LIBRES Y APOYOS

'PARA LÍNEA LÍMITE DE

End With
Next
'XXX NUMERACIÓN DE FILAS XXX
For i = 1 To co
Hoja1.Cells(4 + i, 61 + 6 * lnum.ListCount) = clibres(i)
Hoja1.Cells(4 + i, 61 + 6 * lnum.ListCount).Select
With Selection
.Font.Bold = True
.Borders(xlEdgeRight).LineStyle = 12
IZQUIERDO DE NUDOS LIBRES

'PARA PONER BORDE

End With
Hoja1.Cells(4 + i, 61 + 12 * lnum.ListCount).Select
With Selection
.Borders(xlEdgeRight).LineStyle = 12
DERECHO DE NUDOS LIBRES

'PARA PONER BORDE

End With
Hoja1.Cells(4 + i, 61 + 6 * lnum.ListCount + co).Select
With Selection
.Borders(xlEdgeRight).LineStyle = 5
NUDOS LIBRES Y APOYOS

'PARA LÍNEA LÍMITE DE

End With
Next
For i = 1 To cx
Hoja1.Cells(4 + i + co, 61 + 6 * lnum.ListCount) = ncon(i, 1)
Hoja1.Cells(4 + i + co, 61 + 6 * lnum.ListCount).Select
With Selection
.Font.Bold = True
.Borders(xlEdgeRight).LineStyle = 12
IZQUIERDO DE APOYOS

'PARA PONER BORDE

End With
Hoja1.Cells(4 + i + co, 61 + 12 * lnum.ListCount).Select
With Selection
.Borders(xlEdgeRight).LineStyle = 12
DERECHO DE APOYOS

'PARA PONER BORDE

End With
Hoja1.Cells(4 + i + co, 61 + 6 * lnum.ListCount + co).Select
With Selection
.Borders(xlEdgeRight).LineStyle = 5
NUDOS LIBRES Y APOYOS
End With
Next

'XXXXX CREACIÓN DE LA MATRIZ Koo XXXXX
ReDim Koo(1 To co, 1 To co)
For i = 1 To co
For j = 1 To co
Koo(i, j) = mr(i, j)
Next
Next

'PARA LÍNEA LÍMITE DE

'XXXXX CREACIÓN DE LA MATRIZ Kox Y Kxo XXXXX
ReDim Kox(1 To co, 1 To cx)
ReDim Kxo(1 To cx, 1 To co)
For i = 1 To co
For j = co + 1 To 6 * (lnum.ListCount)
Kox(i, j - co) = mr(i, j)
Kxo(j - co, i) = mr(j, i)
Next
Next

'XXXXX CREACIÓN DE LA MATRIZ Kxx XXXXX
ReDim Kxx(1 To cx, 1 To cx)
For i = co + 1 To co + cx
For j = co + 1 To co + cx
Kxx(i - co, j - co) = mr(i, j)
Next
Next

'XXXXX CREACION DE LA MATRIZ INVERSA XXXXX
ReDim inv(1 To co, 1 To co)
ReDim auxx3(1 To co, 1 To 2 * co)
For i = 1 To co
For j = 1 To co
inv(i, j) = 0
inv(i, i) = 1
Next
Next
For i = 1 To co
For j = 1 To co

auxx3(i, j) = Koo(i, j)
auxx3(i, i + co) = 1
Next
Next
'XXX MÉTODO DE GAUSS JORDAN PARA INVERTIR MATRICES XXX
aux1 = 0
aux2 = 0
For i = 1 To co - 1
pb1 = auxx3(i, i)
For j = i + 1 To co
pb2 = auxx3(j, i)
For k = 1 To 2 * co
auxx3(j, k) = auxx3(j, k) - (pb2 / pb1) * auxx3(i, k)
Next
Next
Next

For i = 1 To co
pb1 = auxx3(i, i)
For j = 1 To 2 * co
auxx3(i, j) = auxx3(i, j) / pb1
Next
Next

For i = co To 2 Step -1
For j = i - 1 To 1 Step -1
pb2 = auxx3(j, i)
For k = 1 To 2 * co
auxx3(j, k) = auxx3(j, k) - (pb2) * auxx3(i, k)

Next
Next
Next

'XXXXX SEPARAR LA MATRIZ INVERSA XXXXX
For i = 1 To co
For j = 1 To co
inv(i, j) = auxx3(i, j + co)
Next
Next

'XXXXX CALCULAR EL Do XXXXX
ReDim auxx4(1 To co)
ReDim Dx(1 To cx)
ReDim Do1(1 To co)
ReDim Qo(1 To co)

For i = 1 To co
auxx4(i) = 0
Do1(i) = 0
Qo(i) = 0
Next
For i = 1 To cx
Dx(i) = 0
Next

For i = 1 To cx

'For j = 1 To 6
'aux1 = j + 6 * (i - 1)
Dx(i) = ncon(i, 2)
'Next
Next
For i = 1 To co
For j = 1 To cx
auxx4(i) = auxx4(i) + Kox(i, j) * Dx(j)
Next
Next
'xxxx PASAR EL Qot A UNA MATRIZ COLUMNA Qotc XXXXX
ReDim Qotc(1 To 6 * lnum.ListCount)
For i = 1 To lnum.ListCount
For j = 1 To 6
Qotc(j + 6 * (i - 1)) = Qot(i, j + 1)
Next
Next

For i = 1 To co
'For j = 1 To 6
Qo(i) = Qotc(clibres(i))
' Next
Next
'XXXXX GENERAR LA MATRIZ Do EN EL SCG XXXXX
For i = 1 To co
For j = 1 To co
Do1(i) = Do1(i) + inv(i, j) * (Qo(j) - auxx4(j))
Next
Next

'XXXXX PARA CREAR Qx XXXXX
ReDim auxx5(1 To cx)
ReDim auxx6(1 To cx)
ReDim Qx(1 To cx)
'XXXXX PARA GENERAR Kxo.Do XXXXX
For i = 1 To cx
For j = 1 To co
auxx5(i) = auxx5(i) + Kxo(i, j) * Do1(j)
Next
Next

'XXXXX PARA GENERAR Kxx.Dx XXXXX
For i = 1 To cx
For j = 1 To cx
auxx6(i) = auxx6(i) + Kxx(i, j) * Dx(j)
Next
Next

'XXXXX PARA GENERAR Qx XXXXX
For i = 1 To cx
Qx(i) = auxx5(i) + auxx6(i)
Next

'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
End Sub

'________________________________ MANDAR Do Y Qx AL EXCEL
____________________ BOTÓN Do, Qx

Private Sub CommandButton14_Click()

Application.ScreenUpdating = False

'XXXXX PASAR Do AL EXCEL XXXXX
For i = 1 To co
Hoja1.Cells(i + 4, 65 + 12 * lnum.ListCount) = Do1(i)
Hoja1.Cells(i + 4, 65 + 12 * lnum.ListCount).Select
With Selection
.Borders(xlEdgeRight).LineStyle = 12
.Borders(xlEdgeLeft).LineStyle = 12
End With
Next

'XXXXX PASAR Qx AL EXCEL XXXXX
For i = 1 To cx
Hoja1.Cells(i + 4, 68 + 12 * lnum.ListCount) = Qx(i)
Hoja1.Cells(i + 4, 68 + 12 * lnum.ListCount).Select
With Selection
.Borders(xlEdgeRight).LineStyle = 12

.Borders(xlEdgeLeft).LineStyle = 12
End With
Next

'XXXXX COLOCAR NUMERACIÓN A Do XXXXX
Hoja1.Cells(3, 65 + 12 * lnum.ListCount) = "DESPLAZAMIENTOS SCG"
Hoja1.Cells(4, 65 + 12 * lnum.ListCount) = "Do"
Hoja1.Cells(4, 65 + 12 * lnum.ListCount).Select
With Selection
.Font.Bold = True
End With
Hoja1.Cells(3, 65 + 12 * lnum.ListCount).Select
With Selection
.Font.Bold = True
End With
For i = 1 To co
For j = 0 To 5
Hoja1.Cells(4 + i, 64 + 12 * lnum.ListCount) = clibres(i)
Hoja1.Cells(4 + i, 64 + 12 * lnum.ListCount).Select
With Selection
.Font.Bold = True
End With
Next
Next

'XXXXX COLOCAR NUMERACIÓN A Qx XXXXX
Hoja1.Cells(3, 68 + 12 * lnum.ListCount) = "REACCIONES SCG"
Hoja1.Cells(4, 68 + 12 * lnum.ListCount) = "Qx"

Hoja1.Cells(4, 68 + 12 * lnum.ListCount).Select
With Selection
.Font.Bold = True
End With
Hoja1.Cells(3, 68 + 12 * lnum.ListCount).Select
With Selection
.Font.Bold = True
End With
For i = 1 To cx
For j = 0 To 5
Hoja1.Cells(4 + i, 67 + 12 * lnum.ListCount) = ncon(i, 1)
Hoja1.Cells(4 + i, 67 + 12 * lnum.ListCount).Select
With Selection
.Font.Bold = True
End With
Next
Next

'XXXXX MANDAR LA MATRIZ DE TODAS LAS CARGAS EN EL SCG AL EXCEL
XXXXX
For i = 1 To 6 * lnum.ListCount

Hoja1.Cells(8 + co + i, 65 + 12 * lnum.ListCount) = Qotc(i)
Hoja1.Cells(8 + co + i, 65 + 12 * lnum.ListCount).Select
With Selection
.Borders(xlEdgeRight).LineStyle = 12
.Borders(xlEdgeLeft).LineStyle = 12
End With

Next

Hoja1.Cells(7 + co, 65 + 12 * lnum.ListCount) = "CARGAS EN EL SGC"
Hoja1.Cells(7 + co, 65 + 12 * lnum.ListCount).Select
With Selection
.Font.Bold = True
End With

For i = 1 To 6 * lnum.ListCount

Hoja1.Cells(8 + co + i, 64 + 12 * lnum.ListCount) = i
Hoja1.Cells(8 + co + i, 64 + 12 * lnum.ListCount).Select
With Selection
.Font.Bold = True
End With

Next

'XXXXX CARGAR LOS DATOS DE QXE XXXXX
ReDim QxA(1 To cx) As Double
For i = 1 To cx
'For j = 1 To 6
QxA(i) = Qotc(ncon(i, 1))
'Next
Next

'XXXXX PASAR QxA AL EXCEL XXXXX
For i = 1 To cx
Hoja1.Cells(i + 4, 70 + 12 * lnum.ListCount) = QxA(i)

Hoja1.Cells(i + 4, 70 + 12 * lnum.ListCount).Select
With Selection
.Borders(xlEdgeRight).LineStyle = 12
.Borders(xlEdgeLeft).LineStyle = 12
End With
Next
Hoja1.Cells(3, 70 + 12 * lnum.ListCount) = "Q EQUIVALENTES SCG"
Hoja1.Cells(3, 70 + 12 * lnum.ListCount).Select
With Selection
.Font.Bold = True
End With

'XXXXX CALCULAR LOS VALORES DEL Qxfinales XXXXX
ReDim Qxfinal(1 To cx) As Double
For i = 1 To cx
Qxfinal(i) = Qx(i) - QxA(i)
Next

'XXXXX PASAR QxA AL EXCEL XXXXX
For i = 1 To cx
Hoja1.Cells(i + 4, 72 + 12 * lnum.ListCount) = Qxfinal(i)
Hoja1.Cells(i + 4, 72 + 12 * lnum.ListCount).Select
With Selection
.Borders(xlEdgeRight).LineStyle = 12
.Borders(xlEdgeLeft).LineStyle = 12
End With
Next
Hoja1.Cells(3, 72 + 12 * lnum.ListCount) = "Q finles SCG"
Hoja1.Cells(3, 72 + 12 * lnum.ListCount).Select

With Selection
.Font.Bold = True
End With

'XXXXX GENERAR LA MATRIZ TOTAL DE LOS ELEMENTOS MT EN SCG XXXXX
ReDim MT(1 To 6 * lnum.ListCount, 2)
For i = 1 To co
MT(clibres(i), 1) = clibres(i)
MT(clibres(i), 2) = Do1(i)
Next
For i = 1 To cx
MT(ncon(i, 1), 1) = ncon(i, 1)
MT(ncon(i, 1), 2) = Dx(i)
Next

'XXXXX PARA GENERAR EL qi DE CADA ELEMENTO XXXXX
For i = 1 To 12
For j = 1 To 12
t(i, j) = 0
Next
Next
'XXXXX PARA CÁCULOS GENERALES XXXXX
For j = 1 To lnu.ListCount
'XXX HACER CEROS LA MATRIZ DE DESPLAZAMIENTOS LOCALES (di) XXX
For k = 1 To 12
di(k) = 0

dia(k) = 0
qoi(k) = 0
qf(k) = 0
qfinal(k) = 0
Next

'XXXXX GENERAR T PARA CADA ELEMENTO XXXXX
For k = 0 To 3
t(1 + 3 * k, 1 + 3 * k) = u1x(j)
t(1 + 3 * k, 2 + 3 * k) = u1y(j)
t(1 + 3 * k, 3 + 3 * k) = u1z(j)
t(2 + 3 * k, 1 + 3 * k) = u2x(j) * Cos(aux(j) * 3.14159 / 180) + u3x(j) * Sin(aux(j) *
3.14159 / 180)
t(2 + 3 * k, 2 + 3 * k) = u2y(j) * Cos(aux(j) * 3.14159 / 180) + u3y(j) * Sin(aux(j) *
3.14159 / 180)
t(2 + 3 * k, 3 + 3 * k) = u2z(j) * Cos(aux(j) * 3.14159 / 180) + u3z(j) * Sin(aux(j) *
3.14159 / 180)
t(3 + 3 * k, 1 + 3 * k) = -u2x(j) * Sin(aux(j) * 3.14159 / 180) + u3x(j) * Cos(aux(j) *
3.14159 / 180)
t(3 + 3 * k, 2 + 3 * k) = -u2y(j) * Sin(aux(j) * 3.14159 / 180) + u3y(j) * Cos(aux(j) *
3.14159 / 180)
t(3 + 3 * k, 3 + 3 * k) = -u2z(j) * Sin(aux(j) * 3.14159 / 180) + u3z(j) * Cos(aux(j) *
3.14159 / 180)
Next

'XXXXX CREAR EL VECTOR DE DESPLAZAMIENTOS dia XXXXX
'XXX PARA NUDOS LIBRES XXX
'For i = 1 To lnum.ListCount
'If auxx2(i) = lsi(j) Then
For k = 1 To 6
dia(k) = MT(k + 6 * (lsi(j) - 1), 2)

Next
For k = 1 To 6
dia(k + 6) = MT(k + 6 * (lsj(j) - 1), 2)
Next
'End If
'If auxx2(i) = lsj(j) Then
'For k = 1 To 6
'dia(k + 6) = Do1(k + 6 * (i - 1))
'Next
'End If
'Next
'XXX PARA LOS APOYOS XXX
'For i = 1 To UserForm2.lstdn.ListCount
'If lapoy(i, 1) = lsi(j) Then
'For k = 1 To 6
'dia(k) = Dx(k + 6 * (i - 1))
'Next
'End If
'If lapoy(i, 1) = lsj(j) Then
'For k = 1 To 6
'dia(k + 6) = Dx(k + 6 * (i - 1))
'Next
'End If
'Next

'XXXXX PASAR EL VECTOR "D" AL SISTEMA LOCAL DE COORDENADAS
XXXXX
For i = 1 To 12
For l = 1 To 12

di(i) = t(i, l) * dia(l) + di(i)
Next
Next

'XXXXX CONSEGUIR LOS q LOCALES XXXXX
For i = 1 To 12
For l = 1 To 12
kl(i, l) = 0
Next
Next

'XXX MATRIZ DE RIGIDEZ LOCAL XXX

s(1) = lse(j) * lsarea(j) / lmod(j)
s(2) = 12 * lse(j) * lin3(j) / lmod(j) ^ 3
s(3) = 12 * lse(j) * lin2(j) / lmod(j) ^ 3
s(4) = lsg(j) * linj(j) / lmod(j)
s(5) = 4 * lse(j) * lin2(j) / lmod(j)
s(6) = 4 * lse(j) * lin3(j) / lmod(j)
s(7) = 6 * lse(j) * lin2(j) / lmod(j) ^ 2
s(8) = 6 * lse(j) * lin3(j) / lmod(j) ^ 2
s(9) = 2 * lse(j) * lin2(j) / lmod(j)
s(10) = 2 * lse(j) * lin3(j) / lmod(j)
kl(1, 1) = s(1)
kl(7, 1) = -s(1)
kl(2, 2) = s(2)
kl(6, 2) = s(8)
kl(8, 2) = -s(2)
kl(12, 2) = s(8)

kl(3, 3) = s(3)
kl(5, 3) = -s(7)
kl(9, 3) = -s(3)
kl(11, 3) = -s(7)
kl(4, 4) = s(4)
kl(10, 4) = -s(4)
kl(3, 5) = -s(7)
kl(5, 5) = s(5)
kl(9, 5) = s(7)
kl(11, 5) = s(9)
kl(2, 6) = s(8)
kl(6, 6) = s(6)
kl(8, 6) = -s(8)
kl(12, 6) = s(10)
kl(1, 7) = -s(1)
kl(7, 7) = s(1)
kl(2, 8) = -s(2)
kl(6, 8) = -s(8)
kl(8, 8) = s(2)
kl(12, 8) = -s(8)
kl(3, 9) = -s(3)
kl(5, 9) = s(7)
kl(9, 9) = s(3)
kl(11, 9) = s(7)
kl(4, 10) = -s(4)
kl(10, 10) = s(4)
kl(3, 11) = -s(7)
kl(5, 11) = s(9)
kl(9, 11) = s(7)

kl(11, 11) = s(5)
kl(2, 12) = s(8)
kl(6, 12) = s(10)
kl(8, 12) = -s(8)
kl(12, 12) = s(6)

'XXXXX CÁLCULO DE qoi XXXXX
For i = 1 To 12
For l = 1 To 12
qoi(i) = kl(i, l) * di(l) + qoi(i)
Next
Next

'XXXXX CREAR EL qf SISTEMA LOCAL XXXXX
For i = 1 To UserForm4.lstel.ListCount
If UserForm4.lstel.List(i - 1) = lnu.List(j - 1) Then
qf(1) = (UserForm4.lstq1.List(i - 1)) + qf(1)
qf(2) = (UserForm4.lstq2.List(i - 1)) + qf(2)
qf(3) = (UserForm4.lstq3.List(i - 1)) + qf(3)
qf(4) = (UserForm4.lstq4.List(i - 1)) + qf(4)
qf(5) = (UserForm4.lstq5.List(i - 1)) + qf(5)
qf(6) = (UserForm4.lstq6.List(i - 1)) + qf(6)
qf(7) = (UserForm4.lstq7.List(i - 1)) + qf(7)
qf(8) = (UserForm4.lstq8.List(i - 1)) + qf(8)
qf(9) = (UserForm4.lstq9.List(i - 1)) + qf(9)
qf(10) = (UserForm4.lstq10.List(i - 1)) + qf(10)
qf(11) = (UserForm4.lstq11.List(i - 1)) + qf(11)
qf(12) = (UserForm4.lstq12.List(i - 1)) + qf(12)
End If

Next
For i = 1 To 12
qfinal(i) = qoi(i) - qf(i)
Next

'XXXXX COLOCAR dia, T y di EN EL EXCEL XXXXX
For i = r + 19 + 15 * (j - 1) To r + 30 + 15 * (j - 1)
For l = 61 To 72
Hoja1.Cells(i, 74) = dia(i - (18 + r + 15 * (j - 1)))
Hoja1.Cells(i, l) = t(i - (18 + r + 15 * (j - 1)), l - 60)
Hoja1.Cells(i, 76) = di(i - (18 + r + 15 * (j - 1)))
Next
Next

'XXXXX COLOCAR qoi EN EL EXCEL XXXXX
For i = r + 19 + 15 * (j - 1) To r + 30 + 15 * (j - 1)
For l = 80 To 91
Hoja1.Cells(i, 93) = qoi(i - (18 + r + 15 * (j - 1)))
Hoja1.Cells(i, l) = kl(i - (18 + r + 15 * (j - 1)), l - 79)
Next
Next

'XXXXX COLOCAR qf y qfinal EN EL EXCEL XXXXX
For i = r + 19 + 15 * (j - 1) To r + 30 + 15 * (j - 1)
Hoja1.Cells(i, 95) = -qf(i - (18 + r + 15 * (j - 1)))
Hoja1.Cells(i, 97) = qfinal(i - (18 + r + 15 * (j - 1)))

'EXPORTAR A LA HOJA 9 PARA GRAFICAS
'If i < r + 22 + 15 * (j - 1) Then
' Hoja9.Cells(17 + 13 * (j - 1) + i - r - 19 - 15 * (j - 1) + 1, 3) = qfinal(i - (18 + r + 15 *
(j - 1)))
'End If
Next

Next
'XXXXX COLOCAR TÍTULOS, NUMERACIONES, BORDES XXXXX
For j = 1 To lnu.ListCount
For i = r + 19 + 15 * (j - 1) To r + 30 + 15 * (j - 1)
'XXXXX MARCO DE LOS Di XXXXX
Hoja1.Cells(i, 74).Select
With Selection
.Borders(xlEdgeRight).LineStyle = 12
.Borders(xlEdgeLeft).LineStyle = 12
End With
'XXXXX MARCO DE LOS di XXXXX
Hoja1.Cells(i, 76).Select
With Selection
.Borders(xlEdgeRight).LineStyle = 12
.Borders(xlEdgeLeft).LineStyle = 12
End With
'XXXXX MARCO DE LOS qo DE FIJACIÓN XXXXX
Hoja1.Cells(i, 95).Select
With Selection
.Borders(xlEdgeRight).LineStyle = 12
.Borders(xlEdgeLeft).LineStyle = 12
End With

'XXXXX MARCO DE LOS qfinales XXXXX
Hoja1.Cells(i, 97).Select
With Selection
.Borders(xlEdgeRight).LineStyle = 12
.Borders(xlEdgeLeft).LineStyle = 12
End With
'XXXXX MARCO DE LOS q LOCALES XXXXX
Hoja1.Cells(i, 93).Select
With Selection
.Borders(xlEdgeRight).LineStyle = 12
.Borders(xlEdgeLeft).LineStyle = 12
End With
'XXXX MARCO DE LA MATRIZ T XXXXX
Hoja1.Cells(i, 61).Select
With Selection
.Borders(xlEdgeLeft).LineStyle = 12
End With
Hoja1.Cells(i, 72).Select
With Selection
.Borders(xlEdgeRight).LineStyle = 12
End With
'XXXX MARCO DE LA MATRIZ Kl XXXXX
Hoja1.Cells(i, 80).Select
With Selection
.Borders(xlEdgeLeft).LineStyle = 12
End With
Hoja1.Cells(i, 91).Select
With Selection
.Borders(xlEdgeRight).LineStyle = 12

End With

Hoja1.Cells(r + 17 + 15 * (j - 1), 65) = "MATRIZ DE TRASFORMACIÓN: " & j
Hoja1.Cells(r + 17 + 15 * (j - 1), 74) = "D" & j
Hoja1.Cells(r + 17 + 15 * (j - 1), 76) = "d" & j
Hoja1.Cells(r + 17 + 15 * (j - 1), 85) = "MATRIZ DE RIGIDEZ LOCAL: " & j
Hoja1.Cells(r + 17 + 15 * (j - 1), 95) = "qo " & j
Hoja1.Cells(r + 17 + 15 * (j - 1), 97) = "qfinal " & j
Hoja1.Cells(r + 17 + 15 * (j - 1), 93) = "qlocal " & j

Next
Next

'ANADIR VECTORES Y COORDENADAS
'For jp = 1 To lnu.ListCount
'coord
'Hoja8.Cells(10 + 22 * (jp - 1) + 1, 3) = Hoja1.Cells(7 + Hoja1.Cells(21 + jp, 3), 5)
'Hoja8.Cells(10 + 22 * (jp - 1) + 2, 3) = Hoja1.Cells(7 + Hoja1.Cells(21 + jp, 3), 6)
'Hoja8.Cells(10 + 22 * (jp - 1) + 3, 3) = Hoja1.Cells(7 + Hoja1.Cells(21 + jp, 4), 5)
'Hoja8.Cells(10 + 22 * (jp - 1) + 4, 3) = Hoja1.Cells(7 + Hoja1.Cells(21 + jp, 4), 6)
'Hoja8.Cells(10 + 22 * (jp - 1) + 5, 3) = Hoja1.Cells(7 + Hoja1.Cells(21 + jp, 3), 7)
'Hoja8.Cells(10 + 22 * (jp - 1) + 6, 3) = Hoja1.Cells(7 + Hoja1.Cells(21 + jp, 4), 7)
'vector unit
' Hoja8.Cells(10 + 22 * (jp - 1) + 1, 5) = Hoja1.Cells(6 + 3 * (jp - 1) + 1, 29)
'Hoja8.Cells(10 + 22 * (jp - 1) + 2, 5) = Hoja1.Cells(6 + 3 * (jp - 1) + 1, 30)
' Hoja8.Cells(10 + 22 * (jp - 1) + 3, 5) = Hoja1.Cells(6 + 3 * (jp - 1) + 2, 29)
'' Hoja8.Cells(10 + 22 * (jp - 1) + 4, 5) = Hoja1.Cells(6 + 3 * (jp - 1) + 2, 30)
' Hoja8.Cells(10 + 22 * (jp - 1) + 5, 5) = Hoja1.Cells(6 + 3 * (jp - 1) + 1, 31)

' Hoja8.Cells(10 + 22 * (jp - 1) + 6, 5) = Hoja1.Cells(6 + 3 * (jp - 1) + 2, 31)
' Hoja8.Cells(10 + 22 * (jp - 1) + 7, 5) = Hoja1.Cells(6 + 3 * (jp - 1) + 3, 29)
' Hoja8.Cells(10 + 22 * (jp - 1) + 8, 5) = Hoja1.Cells(6 + 3 * (jp - 1) + 3, 30)
' Hoja8.Cells(10 + 22 * (jp - 1) + 9, 5) = Hoja1.Cells(6 + 3 * (jp - 1) + 3, 31)
'q finales
' Hoja8.Cells(22 + 22 * (jp - 1) + 1, 3) = Hoja1.Cells(r + 18 + 15 * (jp - 1) + 1, 97)
' Hoja8.Cells(22 + 22 * (jp - 1) + 2, 3) = Hoja1.Cells(r + 18 + 15 * (jp - 1) + 2, 97)
' Hoja8.Cells(22 + 22 * (jp - 1) + 3, 3) = Hoja1.Cells(r + 18 + 15 * (jp - 1) + 6, 97)
' Hoja8.Cells(22 + 22 * (jp - 1) + 4, 3) = Hoja1.Cells(r + 18 + 15 * (jp - 1) + 4, 97)
' Hoja8.Cells(22 + 22 * (jp - 1) + 5, 3) = Hoja1.Cells(r + 18 + 15 * (jp - 1) + 3, 97)
' Hoja8.Cells(22 + 22 * (jp - 1) + 6, 3) = Hoja1.Cells(r + 18 + 15 * (jp - 1) + 5, 97)
'Next

End Sub

'_____________________________OTRAS OPCIONES
_________________________________________________

'XXXXX CAMBIAR DE FORMULARIOS XXXXX
Private Sub CommandButton11_Click()
UserForm1.Hide
UserForm2.Show
End Sub

Private Sub CommandButton12_Click()
UserForm1.Hide
UserForm4.Show
End Sub

'XXXXX OCULTAR FORMULARIO XXXXX
Private Sub CommandButton5_Click()

UserForm1.Hide

End Sub

'XXXXX LIMPIAR FORMULARIO XXXXX
Private Sub CommandButton7_Click()

txtnum.Text = 1
txtnu.Text = 1
lnum.Clear
lx.Clear
ly.Clear
lz.Clear
lt.Clear
lnu.Clear
li.Clear
lj.Clear
ltipo.Clear
le.Clear
lg.Clear
lu.Clear
lb.Clear
lh.Clear
ld.Clear

lelem.Clear
lang.Clear

End Sub

'XXXXX CERRAR EL PROGRAMA XXXXX
Private Sub CommandButton6_Click()

End

End Sub

Private Sub UserForm_Click()
Frame5.Visible = True
Frame6.Visible = True
Frame7.Visible = True
Frame9.Visible = True
Frame1.Top = 186
'Frame2.Top = 186
Frame4.Top = 186
Frame1.Height = 270
'Frame2.Height = 270
Frame4.Height = 270
lnum.Height = 200
lx.Height = 200
ly.Height = 200
lz.Height = 200

lnu.Height = 200
li.Height = 200
lj.Height = 200
lelem.Height = 200
le.Height = 200
lg.Height = 200
lu.Height = 200
lb.Height = 200
lh.Height = 200
ld.Height = 200
lang.Height = 200
ltipo.Height = 200
lt.Height = 200
End Sub

Private Sub UserForm_Initialize()

Label83.Caption = Hoja8.Cells(6, 7)
TextBox7.Value = Label83.Caption
Label83.Caption = Hoja8.Cells(6, 8)
TextBox8.Value = Label83.Caption
Label83.Caption = Hoja8.Cells(6, 9)
TextBox9.Value = Label83.Caption
Label83.Caption = Hoja8.Cells(6, 10)
TextBox10.Value = Label83.Caption
Label83.Caption = Hoja8.Cells(6, 11)
TextBox11.Value = Label83.Caption
Label83.Caption = Hoja8.Cells(6, 12)
TextBox12.Value = Label83.Caption

Label83.Caption = ""

TextBox13.Value = 30
Label83.Caption = 0.1
TextBox14.Value = Label83.Caption

TextBox15.Value = 2

Label83.Caption = "JEAN P"

End Sub