Hola, aqui os dejo una función para obtener la configuracion electronica de cualquier elemento de la tabla periódica... :)
Mas info: http://es.wikipedia.org/wiki/Configuraci%C3%B3n_electr%C3%B3nica
' ////////////////////////////////////////////////////////////////
' // *Autor: *PsYkE1* [vbpsyke1@mixmail.com] //
' // *Fecha: 20/7/10 //
' // *Podeis agrandar o reducir el codigo, siempre y cuando se //
' // respete la autoria y se me comuniquen esos cambios. //
' // *Agradecimientos a raul338 //
' // *Visita http://foro.rthacker.net //
' ////////////////////////////////////////////////////////////////
Option Explicit
Public Function Get_Electronic_Configuration(ByVal bElementValence As Byte) As Collection
Const ELECTRONIC_CONF As String = "1s,2s,2p,3s,3p,4s,3d,4p,5s,4d,5p,6s,4f,5d,6p,7s,5f,6d"
Const EXCEPTION_VALENCES_A As String = "24,29" '# Cr & Cu
Const EXCEPTION_VALENCES_B As String = "41,42,44,45,46,47" '# Zr, Nb, Tc, Ru, Rh, Pd & Ag
Const EXCEPTION_VALENCES_C As String = "78,79" '# Pt & Au
Const LIMIT_SUBLEVEL_S As Byte = 2
Const LIMIT_SUBLEVEL_P As Byte = 6
Const LIMIT_SUBLEVEL_D As Byte = 10
Const LIMIT_SUBLEVEL_F As Byte = 14
Dim cTemp As New Collection
Dim sSubLevel() As String
Dim sActualItem As String * 2
Dim bInvalidValenceA As Boolean
Dim bInvalidValenceB As Boolean
Dim bInvalidValenceC As Boolean
Dim bElectron As Byte
Dim bActualLimit As Byte
Dim x As Byte
Dim n As Byte
Dim y As Byte
If bElementValence > 0 And bElementValence < 112 Then '# Hasta el elemento Roentgenio [Uuu]
sSubLevel() = Split(ELECTRONIC_CONF, ",")
'# Compruebo si la valencia introducida es una excepción
bInvalidValenceA = CBool (InStr(EXCEPTION_VALENCES_A, CStr(bElementValence)))
bInvalidValenceB = CBool (InStr(EXCEPTION_VALENCES_B, CStr(bElementValence)))
bInvalidValenceC = CBool (InStr(EXCEPTION_VALENCES_C, CStr(bElementValence)))
For x = 0 To UBound(sSubLevel())
sActualItem = sSubLevel(x)
'# Reviso el subnivel en el que me encuentro
Select Case Right$(sActualItem, 1)
Case "s": bActualLimit = LIMIT_SUBLEVEL_S
Case "p": bActualLimit = LIMIT_SUBLEVEL_P
Case "d": bActualLimit = LIMIT_SUBLEVEL_D
Case "f": bActualLimit = LIMIT_SUBLEVEL_F
End Select
'# Relleno cada capa de eletrones
For y = 1 To bActualLimit
If n <> bElementValence Then n = n + 1 Else Exit For
'# Hay excepciones: Si la configuración electrónica acaba en d4 o en d9
'# el subnivel anterior cede un electrón para estabilizarlo (en la mayoria de los casos)
If (sActualItem = "4s" And bInvalidValenceA = True) Or (sActualItem = "5s" And bInvalidValenceB = True) Or _
sActualItem = "6s" And bInvalidValenceC = True Then
bElectron = 1
Exit For
Else
bElectron = bElectron + 1
End If
Next y
'# Añado el Item con los electrones que tenga
cTemp.Add sActualItem & CStr(bElectron)
If n = bElementValence Then Exit For
bElectron = 0
Next x
Set Get_Electronic_Configuration = cTemp
End If
End Function
Para que veais, un ejemplo:
Private Sub Form_Load()
Dim sResult As String
Dim vItem As Variant
Dim z As Byte
z = 29 '# El Cobre [Cu]
For Each vItem In Get_Electronic_Configuration(z)
sResult = sResult & vItem & " "
Next vItem
Debug.Print sResult
End Sub
Me devuelve esto:
Citar1s2 2s2 2p6 3s2 3p6 4s1 3d10
Si en la variable
z pongo
97 (Berkelio [Bk]) me da esto:
Citar1s2 2s2 2p6 3s2 3p6 4s2 3d10 4p6 5s2 4d10 5p6 6s2 4f14 5d10 6p6 7s2 5f9
Bueno esto es todo... ;)
PD: Saludo a mi profesora de clases Marta Suarez :-* :laugh:
DoEvents¡! :P
Muy bueno!!!
Un saludo
Yo hice esto pero mas complejo el año pasado xD
Mira alomejor lo porteo a Java :D
Saludos
Perfecto!! :D
Más complejo?¿
Lo unico que se me ocurre a añadir es que simplificara las configuraciones... :silbar:
Un ejemplo:
El Manganeso [Mn] ; z = 25Su configuración electronica seria esta:
Citar1s2 2s2 2p6 3s2 3p6 4s2 3d5
Se podria simplificar tomando como base la configuración electronica del
Argón [Ar], así:
Citar[Ar] 4s2 3d5
No tengo ni idea de java, pero estaria bien que subieras tu code ;)
DoEvents¡! :P