Interface COM em VBA | 5. Criar uma ferramenta para copiar e mover linhas auxiliares

Inserir ligação

Em primeiro lugar, a biblioteca de objetos do RFEM tem de ser integrada no editor VBA, selecionando "Ferramentas" › "Referências".

Integrar Dlubal RFEM Type Library

Tabela de entrada

Na tabela de entrada devem ser introduzidos o vetor de deslocamento assim como o número de cópias. Para criar a tabela de entrada, é gerado um formulário do utilizador apontando para "Inserir" -> "Formulário de utilizador" no editor VBA. Depois, os comandos necessários são colocados no Userform. Para tal, os comandos desejados são selecionados na caixa de ferramentas e depois inseridos no Userform. As propriedades tais como a altura, a posição e o nome do Userform e os comandos podem ser definidos na janela de propriedades.

Janela de entrada de dados

Para o vetor de deslocamento, só devem ser permitidas casas decimais e para o número de cópias, só números inteiros. O texto original da tabela de entrada está listado em baixo.

Opção Explicit

'------------------------------------------------- -------------------------
' Fechar janela após clicar em Cancelar
'------------------------------------------------- -------------------------
Private Sub cmdClose_Click ()
frmGuideline.Hide
End Sub

'------------------------------------------------- -------------------------
' Abrir procedimento para deslocar/copiar linhas auxiliares e fechar janela após clique em OK
'------------------------------------------------- -------------------------
Private Sub cmdOK_Click ()
If txbAnz.Value = "" Então
txbAnz.Value =

Janela de entrada de dados

'------------------------------------------------- -------------------------
' Funçáo para autorizar só casas decimais
'------------------------------------------------- -------------------------
Função particular TxT_KeyDown (objTextBox As MSForms.TextBox, iKeyCode As Inteiro)As Inteiro
Selecionar caso iKeyCode
' Permitir os seguintes sinais:
' 8 tecla de retrocesso para corrigir
' 48-57 números de 0 a 9
' 96-105 números de 0 a 9 (teclado numérico)
' teclas do cursos ()
' 46 tecla Del
Caso 48 To 57,8,96 To 105,37,39,46: TxT_KeyDown = iKeyCode
' Permitir só um sinal de menos na primeira posiçáo
' 109 menos (teclado numérico)
' 189 menos
Caso 109,189:
If InStr (1, objTextBox, "-", vbTextCompare)> 0 Ou objTextBox.SelStart <> 0 Então
TxT_KeyDown = 0
Else
TxT_KeyDown = 109
End If
' Permitir só uma vírgula ou um ponto e substituir pontos por vírgulas
' 188 vírgula
' 110 vírgula (teclado numérico)
' 190 ponto
Caso 190,188,110:
If InStr (1, objTextBox, ",", vbTextCompare)> 0 Ou objTextBox.SelStart = 0 Então
TxT_KeyDown = 0
Else
TxT_KeyDown = 188
End If
' Ignorar todos os outros sinais
Caso contrário: TxT_KeyDown = 0
Terminar seleção
End Function

'------------------------------------------------- -------------------------
' Permitir só número decimais para a entrada da coordenada X
'------------------------------------------------- -------------------------
Private Sub txbX_KeyDown (ByVal iKeyCode como MSForms.ReturnInteger, ByVal Shift como número inteiro)
iKeyCode = TxT_KeyDown (txbX, CInt (iKeyCode))
End Sub

'------------------------------------------------- -------------------------
' Permitir só número decimais para a entrada da coordenada Y
'------------------------------------------------- -------------------------
Sub privado txbY_KeyDown (ByVal iKeyCode As MSForms.ReturnInteger, ByVal DeslocamentoAs Inteiro)
iKeyCode = TxT_KeyDown (txbY, CInt(iKeyCode))
End Sub

'------------------------------------------------- -------------------------
' Permitir só número decimais para a entrada da coordenada Z
'------------------------------------------------- -------------------------
Private Sub txbZ_KeyDown (ByVal iKeyCode As MSForms.ReturnInteger, ByVal DeslocamentoAs Inteiro)
iKeyCode = TxT_KeyDown (txbZ, CInt(iKeyCode))
End Sub

'------------------------------------------------- -------------------------
' Permiti só números inteiros na entrada do número de cópias
'------------------------------------------------- -------------------------
Private Sub txbAnz_KeyPress (ByVal iKeyCode As MSForms.ReturnInteger)
Selecionar caso iKeyCode
' Permitir só número de 0 a 9
Caso 48 To 57
' Ignorar todos os outros sinais
Caso contrário: iKeyCode = 0
Terminar seleção
End Sub

Deslocar e copiar as linhas auxiliares

O texto original para deslocar e copiar as linhas auxiliares selecionadas é mostrado a seguir. Os passos individuais são explicados nos comentários.

Opção Explicit

Enum Erros e avisos
Err_RFEM = 513 'RFEM não aberto
Err_Model = 514 'Nenhum modelo aberto
Err_Guideline = 515 'Não existem linhas auxiliares disponíveis
Err_Guideline_sel = 516 'Não foram selecionadas linhas auxiliares
End Enum

'------------------------------------------------- -------------------------
' Procedimento para deslocar e copiar linhas auxiliares selecionadas
'------------------------------------------------- -------------------------
Sub SetGuidelines (iAnz As Inteiro, dNodeX, dNodeY, dNodeZ As Double)
Escuro ModeloAs RFEM5.model
Escuro aplicação As RFEM5.Application
Escuro guias As IGuideObjects
Escuro linhas () As Diretiva
Escuro iCountAll, iCountSel, i, iAnzKopie, iGuideNo As Inteiro
Escuro newLayerLine As Diretiva

No erro Ir para ErrorHandler

' Obter interface para o RFEM
If RFEM_open = Verdadeiro então
Definir app = GetObject (, "RFEM5.Application")
Else
' Desencadear erro se o RFEM não estiver aberto
Err.Raise Errors.Err_RFEM
End If

' Bloquear licença COM e acesso ao programa
app.LockLicense

' Obter interface para modelo ativo
If app.GetModelCount> 0 Então
Definir model = app.GetActiveModel
Else
' Desencadear erro se nenhum modelo estiver aberto
Err.Raise Errors.Err_Model
End If

' Obter interface para linhas auxiliares
Definir Guides = Model.GetGuideObjects

' Determinar número de linhas auxiliares
model.GetModelData.EnableSelections (Falso)
iCountAll = model.GetGuideObjects.GetGuidelineCount
If iCountAll = 0 Então
' Desencadear erro se não existirem linhas auxiliares
Erro.Err_Guidelina
End If
iGuideNo = Guides.GetGuideline (iCountAll - 1, AtIndex) .GetData.No

' Determinar número de linhas auxiliares selecionadas
model.GetModelData.EnableSelections (Verdadeiro)
iCountSel = model.GetGuideObjects.GetGuidelineCount

If iCountSel> 0 Então
' Copiar as linhas auxiliares selecionadas
preparar.Modificação
linhas = guias.
If iAnz> 0 Então
Pergunta simples – resposta rápida: iAnzKopie = 1 To iAnz
Pergunta simples – resposta rápida: i = 0 To iCountSel - 1
newLayerLine.WorkPlane = linhas (i) .WorkPlane
' Criar novo ambiente de trabalho se a linha auxiliar tiver de ser copiada para outro ambiente de trabalho
If (linhas (i) .WorkPlane = PlaneXY E dNodeZ <>

Janela de entrada de dados

End Sub

'------------------------------------------------- -------------------------
' Inicialização
'------------------------------------------------- -------------------------
Sub init ()
frmGuideline.txbX.Value = "0"
frmGuideline.txbY.Value = "0"
frmGuideline.txbZ.Value = "0"
frmGuideline.txbAnz.Value = "0"
End Sub

'------------------------------------------------- -------------------------
' Função para verificar se o RFEM está aberto
'------------------------------------------------- -------------------------
Função RFEM_open () Como Booleano
Escuro objWMI, colPro Como objeto

Definir objWMI = GetObject ("winmgmts:" _
& "{impersonationLevel = impersonate}! \\" & "." & "\ root \ cimv2")
Definir colPro = objWMI.ExecQuery _
("Select * from Win32_Process Where Name = 'RFEM64.exe'")
If colPro.Count = 0 Então
RFEM_open = Falso
Else
RFEM_open = Verdadeiro
End If
End Function

Resumo e perspetivas

No artigo foi desenvolvida uma ferramenta para deslocar/copiar linhas auxiliares no RFEM. Da mesma maneira, seria possível criar uma ferramenta identica no RSTAB. A ferramenta é iniciada através da interface de utilizador do Excel. Também é possível integrar esta ferramenta no RFEM ou no RSTAB, conforme descrito neste artigo.