Interface COM en VBA | 5. Création d'un outil pour copier et déplacer des lignes directrices

Insertion d'un lien

La bibliothèque d'objets RFEM doit tout d'abord être intégrée à l'éditeur VBA en cliquant sur « Outils » → « Références ».

Intégrer la RFEM Type Library Dlubal

Tableau d'entrée

Le vecteur de déplacement, ainsi que le nombre de copies, doivent être entrés dans le tableau d'entrée. Pour créer le tableau d'entrée, un formulaire utilisateur doit être généré en pointant sur « Insérer » -> « UserForm » dans l'éditeur VBA. Les commandes nécessaires seront ensuite placées sur le Userform. Il suffit de sélectionner la commande souhaitée dans la boîte à outils et enregistrée sur le userform. Les propriétés comme la taille, position, nom du Userform peuvent être définis dans la fenêtre de propriétés.

Données de base

Lors de l'entrée de données, seules des décimales sont autorisées pour le vecteur de déplacement et seuls des nombres entiers pour le nombre de copies. Le code source du tableau d'entrée est listé ci-dessous.

Option Explicit

'--------------------------------------------------------------------------
' Fermer la fenêtre lorsqu'on clique sur Annuler
'--------------------------------------------------------------------------
Private Sub cmdClose_Click()
frmGuideline.Hide
End Sub

'--------------------------------------------------------------------------
' Ouvrir la procédure pour déplacer/copier les lignes directrices et fermer la fenêtre lorsqu'on clique sur OK
'--------------------------------------------------------------------------
Private Sub cmdOK_Click()
If txbAnz.Value = "" Then
txbAnz.Value =

Données de base

'--------------------------------------------------------------------------
' Fonctionnalité pour n'autoriser que les décimales
'--------------------------------------------------------------------------
Private Function TxT_KeyDown(objTextBox As MSForms.TextBox, iKeyCode As Integer)As Integer
Select Case iKeyCode
' Autoriser les signes suivants :
' 8 retour arrière pour corriger
' 48-57 nombres de 0 à 9
' 96-105 nombres de 0 à 9 (pavé numérique)
' 37, 39 touches de curseur ()
' 46 touche Suppr
Case 48 To 57,8,96 To 105,37,39,46: TxT_KeyDown = iKeyCode
' N'autoriser qu'un signe moins en première position
' 109 moins (pavé numérique)
' 189 moins
Case 109,189:
If InStr(1, objTextBox, "-", vbTextCompare) > 0 Or objTextBox.SelStart <> 0 Then
TxT_KeyDown = 0
Else
TxT_KeyDown = 109
End If
' N'autoriser qu'une virgule ou un point et remplacer le point par la virgule
' 188 virgule
' 110 virgule (pavé numérique)
' 190 point
Case 190,188,110:
If InStr(1, objTextBox, ",", vbTextCompare) > 0 Or objTextBox.SelStart = 0 Then
TxT_KeyDown = 0
Else
TxT_KeyDown = 188
End If
' Ignorer tous les autres signes
Case Else: TxT_KeyDown = 0
End Select
End Function

'--------------------------------------------------------------------------
' N'autoriser que les décimales pour entrer la coordonnée X
'--------------------------------------------------------------------------
Private Sub txbX_KeyDown(ByVal iKeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
iKeyCode = TxT_KeyDown(txbX, CInt(iKeyCode))
End Sub

'--------------------------------------------------------------------------
' N'autoriser que les décimales pour entrer la coordonnée Y
'--------------------------------------------------------------------------
Private Sub txbY_KeyDown(ByVal iKeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
iKeyCode = TxT_KeyDown(txbY, CInt(iKeyCode))
End Sub

'--------------------------------------------------------------------------
' N'autoriser que les décimales pour entrer la coordonnée Z
'--------------------------------------------------------------------------
Private Sub txbZ_KeyDown(ByVal iKeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
iKeyCode = TxT_KeyDown(txbZ, CInt(iKeyCode))
End Sub

'--------------------------------------------------------------------------
' N'autoriser que les nombres entiers pour entrer le nombre de copies
'--------------------------------------------------------------------------
Private Sub txbAnz_KeyPress(ByVal iKeyCode As MSForms.ReturnInteger)
Select Case iKeyCode
' N'autoriser que les nombres de 0 à 9
Case 48 To 57
' Ignorer tous les autres signes
Case Else: iKeyCode = 0
End Select
End Sub

Déplacement et copie des lignes directrices

Le code source pour déplacer et copier les lignes directrices sélectionnées est affiché ci-dessous. Chaque étape est décrite dans les commentaires.

Option Explicit

Enum Errors
Err_RFEM = 513 ' RFEM non ouvert
Err_Model = 514 ' Aucun modèle ouvert
Err_Guideline = 515 ' Aucune ligne directrice disponible
Err_Guideline_sel = 516 ' Aucune ligne directrice sélectionnée
End Enum

'--------------------------------------------------------------------------
' Procédure pour déplacer et copier les lignes directrices sélectionnées
'--------------------------------------------------------------------------
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

' Obtenir l'interface RFEM
If RFEM_open = True Then
Set app = GetObject(, "RFEM5.Application")
Else
' Signaler une erreur si RFEM n'est pas ouvert
Err.Raise Errors.Err_RFEM
End If

' Bloquer le licence COM et l'accès au programme
app.LockLicense

' Atteindre l'interface pour le modèle actif
If app.GetModelCount> 0 Then
Définir model = app.GetActiveModel
Else
' Signaler une erreur si aucun modèle n'est ouvert
Err.Raise Erreurs.Err_Model
End If

' Atteindre l'interface pour les lignes directrices
Définir guides = model.GetGuideObjects

' Définir les numéros des lignes directrices
model.GetModelData.EnableSelections (False)
iCountAll = model.GetGuideObjects.GetGuidelineCount
If iCountAll = 0 Then
' Signaler une erreur si aucune ligne directrice n'est disponible
Err.Raise Erreurs.Err_Guideline
End If
iGuideNo = guides.GetGuideline (iCountAll - 1, AtIndex) .GetData.No

' Définir les numéros des lignes directrices sélectionnées
model.GetModelData.EnableSelections (True)
iCountSel = model.GetGuideObjects.GetGuidelineCount

If iCountSel> 0 Then
' Copier les lignes directrices sélectionnées
guides.PrepareModification
lignes = guides.GetGuidelines ()
If iAnz> 0 Then
Question simple – réponse rapide : iAnzKopie = 1 To iAnz
Question simple – réponse rapide : i = 0 To iCountSel - 1
newLayerLine.WorkPlane = lignes (i) .WorkPlane
' Créer un nouveau plan de travail de la ligne directrice si la ligne directrice doit être copiée vers un autre plan de travail
If (lignes (i) .WorkPlane = PlaneXY Et dNodeZ <>

Données de base

End Sub

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

'--------------------------------------------------------------------------
' Fonctionnalité pour contrôler si RFEM est ouvert
'--------------------------------------------------------------------------
Fonction RFEM_open () Comme booléen
Dim objWMI, colPro Comme objet

Définir objWMI = GetObject ("winmgmts:" _
& "{impersonationLevel = usurper l'identité}! \\" & "." & "\ root \ cimv2")
Définir colPro = objWMI.ExecQuery _
("Sélectionnez * de Win32_Process où Name = 'RFEM64.exe'")
If colPro.Count = 0 Then
RFEM_open =False
Else
RFEM_open =True
End If
End Function

Résumé et aperçu

Dans cet article, nous avons développé un outil pour le déplacement/copie des lignes directrices dans RFEM. La même méthode permet la création d'un outil correspondant pour RSTAB. Le démarrage de l'outil se fait sur Excel. Il est également possible d'intégrer cet outil dans RFEM ou RSTAB comme décrit dans cet article.