Interfaz COM en VBA | 5. Creación de una herramienta para copiar y mover líneas auxiliares

Artículo técnico

RF-COM/RS-COM es una interfaz programable que permite al usuario ampliar los programas principales RFEM y RSTAB mediante macros de entrada personalizables o programas de post-proceso. En este artículo, se desarrollará una herramienta para copiar y mover las guías seleccionadas en RFEM. Es posible copiar o mover las guías auxiliares también a otro plano. VBA en Excel se utilizará como entorno de programación.

Inserción del enlace

El objeto de la biblioteca de RFEM tiene que estar integrado primero en el editor de VBA señalando "Herramientas" → "Referencias".

Figura 01 - Integración del tipo de biblioteca Dlubal RFEM

Tabla de entrada de datos

El vector de desplazamiento, así como también el número de copias, tendrían que introducirse en la tabla de entrada. Para crear una tabla de entrada, se generará un formulario de usuario señalando "Insertar" - "UserForm" en el editor de VBA. Los controles necesarios serán ubicados en el formulario de usuario. Para este objetivo, el control respectivo tiene que seleccionarse en la caja de herramientas y luego guardarse en el formulario de usuario. Las propiedades tales como el tamaño, posición, nombre del formulario de usuario y los controles pueden definirse en la ventana de propiedades.

Figura 02 - Tabla de datos de entrada

Para el vector de desplazamiento sólo se permiten como datos de entrada decimales y para el número de copias números enteros. La fuente del código de la tabla de datos de entrada está indicada a continuación:

Option Explicit

'--------------------------------------------------------------------------
' Cierra la ventana al hacer clic en Cancelar
'--------------------------------------------------------------------------
Private Sub cmdClose_Click()
frmGuideline.Hide
End Sub

'--------------------------------------------------------------------------
' Procedimiento de apertura para mover/copiar las líneas auxiliares y cerrar la ventana la hacer clic en Aceptar
'--------------------------------------------------------------------------
Private Sub cmdOK_Click()
If txbAnz.Value = "" Then
txbAnz.Value = 0
End If
If txbX.Value = "" Then
txbX.Value = 0
End If
If txbY.Value = "" Then
txbY.Value = 0
End If
If txbZ.Value = "" Then
txbZ.Value = 0
End If
Call modGuideline.SetGuidelines(txbAnz.Value, txbX.Value, txbY.Value, txbZ.Value)
frmGuideline.Hide
End Sub

'--------------------------------------------------------------------------
' Función para permitir sólo decimales
'--------------------------------------------------------------------------
Private Function TxT_KeyDown(objTextBox As MSForms.TextBox, iKeyCode As Integer) As Integer
Select Case iKeyCode
' Permitir los signos siguientes:
' 8 tecla de retroceso para corregir
' 48-57 números de 0 a 9
' 96-105 números de 0 a 9 (teclado numérico)
' 37, 39 tecla del cursor ()
' 46 tecla Supr
Case 48 To 57, 8, 96 To 105, 37, 39, 46: TxT_KeyDown = iKeyCode
' Permitir sólo un signo menos en la primera posición
' 109 menos (teclado numérico)
' 189 menos
Case 109, 189:
If InStr(1, objTextBox, "-", vbTextCompare) > 0 Or objTextBox.SelStart <> 0 Then
TxT_KeyDown = 0
Else
TxT_KeyDown = 109
End If
' Permitir sólo una coma o punto y reemplazar punto por coma
' 188 Coma
' 110 Coma (bloque numérico)
' 190 Punto
Case 190, 188, 110:
If InStr(1, objTextBox, ",", vbTextCompare) > 0 Or objTextBox.SelStart = 0 Then
TxT_KeyDown = 0
Else
TxT_KeyDown = 188
End If
' Ignorar todos los demás signos
Case Else: TxT_KeyDown = 0
End Select
End Function

'--------------------------------------------------------------------------
' Permitir sólo decimales para introducir la coordenada X
'--------------------------------------------------------------------------
Private Sub txbX_KeyDown(ByVal iKeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
iKeyCode = TxT_KeyDown(txbX, CInt(iKeyCode))
End Sub

'--------------------------------------------------------------------------
' Permitir sólo decimales para introducir la coordenada Y

'--------------------------------------------------------------------------

Private Sub txbY_KeyDown(ByVal iKeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
iKeyCode = TxT_KeyDown(txbY, CInt(iKeyCode))
End Sub

'--------------------------------------------------------------------------
' Permitir sólo decimales para introducir la coordenada Z
'--------------------------------------------------------------------------
Private Sub txbZ_KeyDown(ByVal iKeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
iKeyCode = TxT_KeyDown(txbZ, CInt(iKeyCode))
End Sub

'--------------------------------------------------------------------------
' Sólo permitir números enteros para introducir el número de copias
'--------------------------------------------------------------------------
Private Sub txbAnz_KeyPress(ByVal iKeyCode As MSForms.ReturnInteger)
Select Case iKeyCode
' Permitir sólo números de 0-9
Case 48 To 57
' Ignorar todos los signos
Case Else: iKeyCode = 0
End Select
End Sub

Movimiento y copia de líneas auxiliares

El código fuente para mover y copiar las líneas auxiliares se lista a continuación. Los sencillos pasos se explican en los comentarios.

Option Explicit

Enum Errors
Err_RFEM = 513 ' RFEM no está abierto
Err_Model = 514 ' No hay ningún modelo abierto
Err_Guideline = 515 ' No está disponible la línea auxiliar
Err_Guideline_sel = 516 ' No hay líneas auxiliares seleccionadas
End Enum

'--------------------------------------------------------------------------
' Procedimiento para mover y copiar las líneas auxiliares seleccionadas
'--------------------------------------------------------------------------
Sub SetGuidelines(iAnz As Integer, dNodeX, dNodeY, dNodeZ As Double)
Dim model As RFEM5.model
Dim app As RFEM5.Application
Dim guides As IGuideObjects
Dim lines() As Guideline
Dim iCountAll, iCountSel, i, iAnzKopie, iGuideNo As Integer
Dim newLayerLine As Guideline

On Error GoTo ErrorHandler

' Conseguir interfaz con RFEM
If RFEM_open = True Then
Set app = GetObject(, "RFEM5.Application")
Else
' Lanzar error si RFEM no está abierto
Err.Raise Errors.Err_RFEM
End If

' Bloquear la licencia de COM y programar acceso
app.LockLicense

' Conseguir interfaz para el modelo activo
If app.GetModelCount > 0 Then
Set model = app.GetActiveModel
Else
' Lanzar error si no está abierto el modelo
Err.Raise Errors.Err_Model
End If

' Conseguir interfaz para líneas auxiliares
Set guides = model.GetGuideObjects

' Definir números para líneas auxiliares
model.GetModelData.EnableSelections (False)
iCountAll = model.GetGuideObjects.GetGuidelineCount
If iCountAll = 0 Then
' Lanzar error si no hay líneas auxiliares disponibles
Err.Raise Errors.Err_Guideline
End If
iGuideNo = guides.GetGuideline(iCountAll - 1, AtIndex).GetData.No

' Definir números de las líneas seleccionadas
model.GetModelData.EnableSelections (True)
iCountSel = model.GetGuideObjects.GetGuidelineCount

If iCountSel > 0 Then
' Copiar líneas seleccionadas
guides.PrepareModification
lines = guides.GetGuidelines()
If iAnz > 0 Then
For iAnzKopie = 1 To iAnz
For i = 0 To iCountSel - 1
newLayerLine.WorkPlane = lines(i).WorkPlane
' Crear un plano de trabajo nuevo si la línea auxiliar debería copiarse a otro plano de trabajo
If (lines(i).WorkPlane = PlaneXY And dNodeZ <> 0) Then
newLayerLine.WorkPlaneOrigin.Z = lines(i).WorkPlaneOrigin.Z + dNodeZ * iAnzKopie
newLayerLine.WorkPlaneOrigin.X = lines(i).WorkPlaneOrigin.X
newLayerLine.WorkPlaneOrigin.Y = lines(i).WorkPlaneOrigin.Y
ElseIf (lines(i).WorkPlane = PlaneYZ And dNodeX <> 0) Then
newLayerLine.WorkPlaneOrigin.X = lines(i).WorkPlaneOrigin.X + dNodeX * iAnzKopie
newLayerLine.WorkPlaneOrigin.Y = lines(i).WorkPlaneOrigin.Y
newLayerLine.WorkPlaneOrigin.Z = lines(i).WorkPlaneOrigin.Z
ElseIf (lines(i).WorkPlane = PlaneXZ And dNodeY <> 0) Then
newLayerLine.WorkPlaneOrigin.Y = lines(i).WorkPlaneOrigin.Y + dNodeY * iAnzKopie
newLayerLine.WorkPlaneOrigin.X = lines(i).WorkPlaneOrigin.X
newLayerLine.WorkPlaneOrigin.Z = lines(i).WorkPlaneOrigin.Z
Else
' Líneas auxiliares en el mismo plano de trabajo
newLayerLine.WorkPlaneOrigin.X = lines(i).WorkPlaneOrigin.X
newLayerLine.WorkPlaneOrigin.Y = lines(i).WorkPlaneOrigin.Y
newLayerLine.WorkPlaneOrigin.Z = lines(i).WorkPlaneOrigin.Z
End If
newLayerLine.Type = lines(i).Type
newLayerLine.Angle = lines(i).Angle
newLayerLine.Radius = lines(i).Radius
' Las coordenadas de las líneas auxiliares (X, Y, Z) de la copia se ajustarán al vector de desplazamiento
newLayerLine.Point1.X = lines(i).Point1.X + dNodeX * iAnzKopie
newLayerLine.Point1.Y = lines(i).Point1.Y + dNodeY * iAnzKopie
newLayerLine.Point1.Z = lines(i).Point1.Z + dNodeZ * iAnzKopie
newLayerLine.Point2.X = lines(i).Point2.X + dNodeX * iAnzKopie
newLayerLine.Point2.Y = lines(i).Point2.Y + dNodeY * iAnzKopie
newLayerLine.Point2.Z = lines(i).Point2.Z + dNodeZ * iAnzKopie
newLayerLine.No = iGuideNo + i + 1
newLayerLine.Description = "Kopie Hilfslinie " + CStr(lines(i).No)
guides.SetGuideline newLayerLine
Next
iCountAll = iCountAll + iCountSel
iGuideNo = guides.GetGuideline(iCountAll - 1, AtIndex).GetData.No
Next
' Movimiento de las líneas auxiliares seleccionadas
Else
For i = 0 To iCountSel - 1
' Movimiento de las líneas auxiliares a otro plano de trabajo
If (lines(i).WorkPlane = PlaneXY And dNodeZ <> 0) Then
lines(i).WorkPlaneOrigin.Z = lines(i).WorkPlaneOrigin.Z + dNodeZ
ElseIf (lines(i).WorkPlane = PlaneYZ And dNodeX <> 0) Then
lines(i).WorkPlaneOrigin.X = lines(i).WorkPlaneOrigin.X + dNodeX
ElseIf (lines(i).WorkPlane = PlaneXZ And dNodeY <> 0) Then
lines(i).WorkPlaneOrigin.Y = lines(i).WorkPlaneOrigin.Y + dNodeY
End If
' Las coordenadas de las líneas auxiliares (X, Y, Z) se ajustarán al vector de desplazamiento
lines(i).Point1.X = lines(i).Point1.X + dNodeX
lines(i).Point1.Y = lines(i).Point1.Y + dNodeY
lines(i).Point1.Z = lines(i).Point1.Z + dNodeZ
lines(i).Point2.X = lines(i).Point2.X + dNodeX
lines(i).Point2.Y = lines(i).Point2.Y + dNodeY
lines(i).Point2.Z = lines(i).Point2.Z + dNodeZ
Next
guides.SetGuidelines lines
End If
guides.FinishModification
Else
' Causar error si no se seleccionan líneas auxiliares
Err.Raise Errors.Err_Guideline_sel
End If

' Tratamiento de errores
ErrorHandler:
If Err.Number <> 0 Then
Select Case Err.Number
Case Errors.Err_RFEM
MsgBox ("RFEM is not opened")
Exit Sub
Case Errors.Err_Model
MsgBox ("No file opened!")
Case Errors.Err_Guideline
MsgBox ("No guidelines available in file " & model.GetName & " !")
Case Errors.Err_Guideline_sel
MsgBox ("No guidelines selected in file " & model.GetName & " !")
Case Else
MsgBox "Error-Nr. : " & Err.Number & vbLf & Err.Description
End Select
End If
' La licencia COM se desbloquea, el acceso al programa es posible de nuevo
app.UnlockLicense

Set app = Nothing
Set model = Nothing
Set guides = Nothing

End Sub

'--------------------------------------------------------------------------
' Inicialización
'--------------------------------------------------------------------------
Sub init()
frmGuideline.txbX.Value = "0"
frmGuideline.txbY.Value = "0"
frmGuideline.txbZ.Value = "0"
frmGuideline.txbAnz.Value = "0"
End Sub

'--------------------------------------------------------------------------
' Función para comprobar si RFEM está abierto
'--------------------------------------------------------------------------
Function RFEM_open() As Boolean
Dim objWMI, colPro As Object

Set objWMI = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & "." & "\root\cimv2")
Set colPro = objWMI.ExecQuery _
("Select * from Win32_Process Where Name = 'RFEM64.exe'")
If colPro.Count = 0 Then
RFEM_open = False
Else
RFEM_open = True
End If
End Function

Resumen y vista general

En este artículo se ha desarrollado una herramienta para mover o copiar líneas auxiliares en RFEM. De la misma manera, se puede crear la herramienta correspondiente para RSTAB. La herramienta se inicia por medio de la interfaz de Excel. También es posible integrarla en RFEM o RSTAB según se describe en este artículo.

Descargas

Enlaces

Contacte con nosotros

Contacte con Dlubal Software

¿Tiene preguntas o necesita asesoramiento? 

Contacte con nosotros o encuentre varias soluciones sugeridas y consejos útiles en nuestra página de preguntas más frecuentes (FAQ).

+34-911-438-160

info@dlubal.com

RFEM Programa principal
RFEM 5.xx

Programa principal

Software de ingeniería estructural de análisis por elementos finitos (AEF) para sistemas estructurales planos o espaciales compuestos de barras, placas, muros, láminas, sólidos y elementos de contacto

Precio de la primera licencia
3.540,00 USD
RSTAB Programa principal
RSTAB 8.xx

Programa principal

El software de ingeniería estructural para el análisis y dimensionado de estructuras de barras, pórticos y entramados realizando cálculos lineales y no lineales de los esfuerzos internos, deformaciones y reacciones en los apoyos

Precio de la primera licencia
2.550,00 USD
RFEM Otros
RF-COM 5.xx

Módulo adicional

Interfaz programable (API) basada en tecnología COM

Precio de la primera licencia
580,00 USD