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".
Ventana de entrada
El vector de desplazamiento, así como también el número de copias, tendrían que introducirse en la tabla de entrada. Para crear la tabla de entrada, se generará un formulario de usuario apuntando a "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.
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:
- código.py#
Opción explícita
'-------------------------------------------------------- ---------------------------
' Cierra la ventana al hacer clic en Cancelar
'-------------------------------------------------------- ---------------------------
Sub privado 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
'-------------------------------------------------------- ---------------------------
Sub privado cmdOK_Click()
If txbNum.Value = "" Entonces
txbNumber.Value = 0
End If
If txbX.Value = "" Entonces
txbX.Value = 0
End If
If txbY.Value = "" Entonces
txbY.Value = 0
End If
If txbZ.Value = "" Entonces
txbZ.Value = 0
End If
Llamar a modGuideline.SetGuidelines(txbAnz.Value, txbX.Value, txbY.Value, txbZ.Value)
frmGuideline.Hide
End Sub
'-------------------------------------------------------- ---------------------------
' Función para permitir sólo decimales
'-------------------------------------------------------- ---------------------------
Función privada TxT_KeyDown(objTextBox As MSForms.TextBox, iKeyCode As Integer) As Integer
Seleccionar caso 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
Caso 48 a 57, 8, 96 a 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
Caso 109, 189:
Si InStr(1, objTextBox, "-", vbTextCompare) > 0 u objTextBox.SelStart <> 0 Entonces
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
Caso 190, 188, 110:
Si InStr(1, objTextBox, , vbTextCompare) > 0 u objTextBox.SelStart = 0 Entonces
TxT_KeyDown = 0
Else
TxT_KeyDown = 188
End If
' Ignorar todos los signos
Caso contrario: TxT_KeyDown = 0
Selección final
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
'-------------------------------------------------------- ---------------------------
Sub privado txbAnz_KeyPress(ByVal iKeyCode As MSForms.ReturnInteger)
Seleccionar caso iKeyCode
' Permitir sólo números de 0-9
Caso 48 a 57
' Ignorar todos los signos
Caso contrario: iKeyCode = 0
Selección final
End Sub
- /código#
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.
- código.py#
Opción explícita
Errores de enumeración
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
Fin de enumeración
'-------------------------------------------------------- ---------------------------
' Procedimiento para mover y copiar las líneas auxiliares seleccionadas
'-------------------------------------------------------- ---------------------------
Subconjunto de líneas auxiliares (iNúm. As Integer, dNodeX, dNodeY, dNodeZ As Double)
- Dim model As RFEM5.model
Dim app As RFEM5.Application
Acotar guías como IGuideObjects
Atenuar líneas() Como línea auxiliar
Dim iCountAll, iCountSel, i, iAnzCopy, iGuideNo As Integer
Atenuar nuevaLíneaDeCapa como línea auxiliar
En caso de error, ir al controlador de errores
' 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
Si app.GetModelCount > 0 Entonces
Establecer modelo = app.GetActiveModel
Else
' Lanzar error si no está abierto el modelo
Err.Generar errores.Err_Model
End If
' Conseguir interfaz para líneas auxiliares
Establecer guías = model.GetGuideObjects
' Definir números para líneas auxiliares
model.GetModelData.EnableSelections (Falso)
iCountAll = model.GetGuideObjects.GetGuidelineCount
Si iCountAll = 0, entonces
' Lanzar error si no hay líneas auxiliares disponibles
Err.Generar errores.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
Si iCountSel > 0, entonces
' Copiar líneas seleccionadas
Guides.PrepareModification
líneas = guías.GetGuidelines()
Si iNumber > 0 Entonces
Para iNúm.Copiar = 1 Hasta iNúm
Para i = 0 Hasta 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) Entonces
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 la línea auxiliar (X, Y, Z) de la copia se ajustan mediante el 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 = "Copiar línea auxiliar" + CStr(lines(i).No)
Guides.SetGuideline newLayerLine
Siguiente
iCountAll = iCountAll + iCountSel
iGuideNo = Guides.GetGuideline(iCountAll - 1, AtIndex).GetData.No
Siguiente
' Movimiento de las líneas auxiliares seleccionadas
Else
Para i = 0 Hasta iCountSel - 1
' Movimiento de las líneas auxiliares a otro plano de trabajo
If (lines(i).WorkPlane = PlaneXY And dNodeZ <> 0) Entonces
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 la línea auxiliar (X, Y, Z) se ajustan mediante el vector de desplazamiento
líneas(i).Punto1.X = líneas(i).Punto1.X + dNodoX
líneas(i).Punto1.Y = líneas(i).Punto1.Y + dNudoY
líneas(i).Punto1.Z = líneas(i).Punto1.Z + dNodoZ
líneas(i).Punto2.X = líneas(i).Punto2.X + dNodoX
líneas(i).Punto2.Y = líneas(i).Punto2.Y + dNudoY
líneas(i).Punto2.Z = líneas(i).Punto2.Z + dNodoZ
Siguiente
Guides.SetGuidelineslines
End If
Guides.FinishModification
Else
' Causar error si no se seleccionan líneas auxiliares
Err.Generar errores.Err_Guideline_sel
End If
' Tratamiento de errores
Controlador de errores:
If Err.Number <> 0 Then
Seleccionar número de error de caso
Errores de caso.Err_RFEM
MsgBox ("RFEM is not opened")
Exit Sub
Errores de caso.Err_Model
MsgBox ("No file opened!")
Caso Errors.Err_Guideline
MsgBox ("No guidelines available in file " & model.GetName & " !")
Caso Errors.Err_Guideline_sel
MsgBox ("No guidelines selected in file " & model.GetName & " !")
Caso contrario
MsgBox "Error núm. : " & Err.Número & vbLf & Err.Descripción
Selección final
End If
' La licencia COM se desbloquea, el acceso al programa es posible de nuevo
app.UnlockLicense
Establecer aplicación = Nada
- Set model = Nothing
Definir guías = Nada
End Sub
'-------------------------------------------------------- ---------------------------
' Inicialización
'-------------------------------------------------------- ---------------------------
Subinicial()
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
'-------------------------------------------------------- ---------------------------
Función RFEM_open() como booleana
Dim objWMI, colPro As Object
Establecer objWMI = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & "." & "\root\cimv2")
Establecer colPro = objWMI.ExecQuery_
("Select * from Win32_Process Donde Nombre = 'RFEM64.exe'")
Si colPro.Count = 0 Entonces
RFEM_open = Falso
Else
RFEM_open = Verdadero
End If
End Function
- /código#
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 integrar esta herramienta en RFEM o RSTAB como se describe en este artículo: