Interfaccia COM in VBA | 5. Creazione di uno strumento per copiare e spostare le linee guida

Inserimento di un link

La libreria di oggetti RFEM deve essere prima integrata nell'editor VBA puntando su "Strumenti" → "Riferimenti".

Integra la libreria dei tipi RFEM di Dlubal

Tabella di input

Il vettore di spostamento e il numero di copie devono essere inseriti nella tabella di input. Per creare la tabella di input, verrà generato un modulo utente puntando su "Inserisci" -> "UserForm" nell'editor VBA. I controlli necessari saranno quindi inseriti nel form utente. A tale scopo, il rispettivo controllo deve essere selezionato nella casella degli strumenti e quindi salvato nel modulo utente. Proprietà come dimensione, posizione, nome del form utente e controlli possono essere definiti nella finestra delle proprietà.

Maschera di input

Come dati di input, dovrebbero essere consentiti solo i decimali per il vettore di spostamento e solo i numeri interi per il numero di copie. Il codice sorgente della tabella di input è elencato di seguito.

Opzione esplicita

'------------------------------------------------- -------------------------
'Chiudi la finestra facendo clic su Annulla
'------------------------------------------------- -------------------------
Sottotitoli privati cmdClose_Click ()
frmGuideline.Hide
End Sub

'------------------------------------------------- -------------------------
'Aprire la procedura per spostare/copiare le linee guida e chiudere la finestra quando si fa clic su OK
'------------------------------------------------- -------------------------
Sottotitoli privati cmdOK_Click ()
If txbAnz.Value = "" Allora
txbAnz.Value =

Maschera di input

'------------------------------------------------- -------------------------
'Funzione per consentire solo i decimali
'------------------------------------------------- -------------------------
Funzione privata TxT_KeyDown (objTextBox As MSForms.TextBox, iKeyCode Come intero)Come intero
Seleziona il caso iKeyCode
'Consenti i seguenti segni:
'8 Tasto Backspace per correggere
'48-57 Numeri da 0 a 9
'96-105 Numeri da 0 a 9 (tastierino numerico)
'37, 39 Tasti cursore ()
'46 Tasto Canc
carico 48 To 57,8,96 To 105,37,39,46: TxT_KeyDown = iKeyCode
'Consenti solo un segno meno nella prima posizione
'109 Meno (tastierino numerico)
'189 Meno
carico 109,189:
If InStr (1, objTextBox, "-", vbTextCompare)> 0 O objTextBox.SelStart <> 0 Allora
TxT_KeyDown = 0
Altrimenti
TxT_KeyDown = 109
End If
'Consenti solo una virgola o un punto e sostituisci il punto con una virgola
'188 Comma
'110 Comma (blocco di Nummern)
'190 Punto
carico 190,188,110:
If InStr (1, objTextBox, ",", vbTextCompare)> 0 Or objTextBox.SelStart = 0 Allora
TxT_KeyDown = 0
Altrimenti
TxT_KeyDown = 188
End If
'Ignora tutti gli altri segni
Caso contrario: TxT_KeyDown = 0
Termina selezione
Termina funzione

'------------------------------------------------- -------------------------
'Consenti solo ai decimali di inserire la coordinata X.
'------------------------------------------------- -------------------------
Sottotitoli privati txbX_KeyDown (ByVal iKeyCode come MSForms.ReturnInteger, ByVal Shift come intero)
iKeyCode = TxT_KeyDown (txbX, CInt (iKeyCode))
End Sub

'------------------------------------------------- -------------------------
'Consenti solo ai decimali di inserire la coordinata Y.
'------------------------------------------------- -------------------------
Private Sub txbY_KeyDown (ByVal iKeyCode As MSForms.ReturnInteger, ByVal SpostaCome intero)
iKeyCode = TxT_KeyDown (txbY, CInt(iKeyCode))
End Sub

'------------------------------------------------- -------------------------
'Consenti solo ai decimali di inserire la coordinata Z.
'------------------------------------------------- -------------------------
Sottotitoli privati txbZ_KeyDown (ByVal iKeyCode As MSForms.ReturnInteger, ByVal SpostaCome intero)
iKeyCode = TxT_KeyDown (txbZ, CInt(iKeyCode))
End Sub

'------------------------------------------------- -------------------------
'Consenti solo ai numeri interi di inserire il numero di copie
'------------------------------------------------- -------------------------
Sottotitoli privati txbAnz_KeyPress (ByVal iKeyCode As MSForms.ReturnInteger)
Seleziona il caso iKeyCode
'Consenti solo numeri compresi tra 0 e 9
carico 48 To 57
'Ignora tutti gli altri segni
Caso contrario: iKeyCode = 0
Termina selezione
End Sub

Spostamento e copia delle linee guida

Il codice sorgente per spostare e copiare le linee guida selezionate è elencato di seguito. I singoli passaggi sono spiegati nei commenti.

Opzione esplicita

Enum Errori e avvisi
Err_RFEM = 513 'RFEM non aperto
Err_Model = 514 'Nessun modello aperto
Err_Guideline = 515 'Nessuna linea guida disponibile
Err_Guideline_sel = 516 'Nessuna linea guida selezionata
End Enum

'------------------------------------------------- -------------------------
'Procedura per spostare e copiare le linee guida selezionate
'------------------------------------------------- -------------------------
Sott SetGuidelines (iAnz Come intero, dNodeX, dNodeY, dNodeZ Come doppio)
Dim modello As RFEM5.model
Dim app As RFEM5.Application
Dim guide As IGuideObjects
Dim linee () As Linea guida
Dim iCountAll, iCountSel, i, iAnzKopie, iGuideNo Come intero
Dim newLayerLine As Linea guida

In caso di errore Vai a ErrorHandler

'Ottieni interfaccia a RFEM
If RFEM_open = Vero allora
Set app = GetObject (, "RFEM5.Application")
Altrimenti
'Solleva l'errore se RFEM non è aperto
Err.Raise errori.Err_RFEM
End If

'Blocca la licenza COM e l'accesso al programma
app.LockLicense

'Ottieni l'interfaccia per il modello attivo
If app.GetModelCount> 0 Allora
Set model = app.GetActiveModel
Altrimenti
'Generare errore se non si apre nessun modello
Err.Raise errori.Err_Model
End If

'Ottieni l'interfaccia per le linee guida
Set guide = model.GetGuideObjects

'Definire il numero di linee guida
model.GetModelData.EnableSelections (Falso)
iCountAll = model.GetGuideObjects.GetGuidelineCount
If iCountAll = 0 Allora
'Segnalare errore se non sono disponibili linee guida
Err.Raise errori.Err_Guideline
End If
iGuideNo = manuali.GetGuideline (iCountTutti - 1, AtIndex) .GetData.No

'Definire i numeri delle linee guida selezionate
model.GetModelData.EnableSelections (Vero)
iCountSel = model.GetGuideObjects.GetGuidelineCount

If iCountSel> 0 Allora
'Copia le linee guida selezionate
guide.PrepareModificazione
lines = guid.GetGuidelines ()
If iAnz> 0 Allora
Per iAnzKopie = 1 To iAnz
Per i = 0 To iCountSel - 1
newLayerLine.WorkPlane = lines (i) .WorkPlane
'Crea nuovo piano di lavoro se la linea guida deve essere copiata in un altro piano di lavoro
If (linee (i) .WorkPlane = PlaneXY E dNodoZ <>

Maschera di input

End Sub

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

'------------------------------------------------- -------------------------
'Funzione per verificare se RFEM è aperto
'------------------------------------------------- -------------------------
Funzione RFEM_open () Come booleano
Dim objWMI, colPro Come oggetto

Set objWMI = GetObject ("winmgmts:" _
& "{impersonationLevel = impersonate}! \\" & "." & "\ root \ cimv2")
Set colPro = objWMI.ExecQuery _
("Seleziona * da Win32_Process Where Name = 'RFEM64.exe'")
If colPro.Count = 0 Allora
RFEM_open = Falso
Altrimenti
RFEM_open = Vero
End If
Termina funzione

Riepilogo e prospettive

Nell'articolo è stato sviluppato uno strumento per spostare/copiare le linee guida in RFEM. Allo stesso modo è possibile creare uno strumento corrispondente per RSTAB. Lo strumento viene avviato tramite l'interfaccia di Excel. È anche possibile integrare questo strumento in RFEM o RSTAB come descritto in questo articolo.