Inserimento del riferimento
La libreria di oggetti di RFEM deve essere prima integrata nell'editor VBA puntando su "Strumenti" → "Riferimenti".
finestre di input
Il vettore di spostamento, così come il numero di copie, dovrebbe essere inserito nella tabella di input. Per creare la tabella di input, verrà generato un form utente puntando su "Inserisci" → "Form utente" 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 form utente. Proprietà come la dimensione, la posizione, il nome del form utente e i controlli possono essere definiti nella finestra delle proprietà.
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.
- code.py#
Opzione esplicita
'-------------------- ---------------------------
' Chiudi la finestra quando si fa clic su Annulla
'-------------------- ---------------------------
Private Sub cmdClose_Click()
frmGuideline.Nascondi
End Sub
'-------------------- ---------------------------
' Aprire la procedura per spostare/copiare le linee guida e chiudere la finestra quando si fa clic su OK
'-------------------- ---------------------------
Private Sub cmdOK_Click()
Se txbNum.Value = "" Allora
txbNumero.Valore = 0
End If
Se txbX.Value = "" Allora
txbX.Value = 0
End If
Se txbY.Value = "" Allora
txbY.Value = 0
End If
Se txbZ.Value = "" Allora
txbZ.Value = 0
End If
Richiamo di modGuideline.SetGuidelines(txbAnz.Value, txbX.Value, txbY.Value, txbZ.Value)
frmGuideline.Nascondi
End Sub
'-------------------- ---------------------------
' Funzione per consentire solo i decimali
'-------------------- ---------------------------
Funzione privata TxT_KeyDown(objTextBox As MSForms.TextBox, iKeyCode As Integer) As Integer
Seleziona iKeyCode del caso
' Consenti i seguenti segni:
' 8 Tasto Backspace da correggere
' 48-57 Numeri da 0 a 9
' 96-105 Numeri da 0 a 9 (tastierino numerico)
' 37, 39 Tasti cursore ()
' 46 Tasto Canc
Caso da 48 a 57, 8, 96 a 105, 37, 39, 46: TxT_KeyDown = iKeyCode
' Consenti solo un segno meno nella prima posizione
' 109 Meno (tastierino numerico)
' 189 meno
Caso 109, 189:
Se InStr(1, objTextBox, "-", vbTextCompare) > 0 o objTextBox.SelStart <> 0 Allora
TxT_KeyDown = 0
Altro
TxT_KeyDown = 109
End If
' Consenti solo una virgola o punto e sostituisci punto con virgola
' 188 Virgola
' 110 Virgola (blocco numerico)
' 190 punti
Caso 190, 188, 110:
Se InStr(1, objTextBox, , vbTextCompare) > 0 O objTextBox.SelStart = 0 Allora
TxT_KeyDown = 0
Altro
TxT_KeyDown = 188
End If
' Ignora tutti gli altri segni
Altro caso: TxT_KeyDown = 0
Seleziona fine
Funzione finale
'-------------------- ---------------------------
' Consenti solo ai decimali di inserire la coordinata X
'-------------------- ---------------------------
Sub privato txbX_KeyDown (ByVal iKeyCode as MSForms.ReturnInteger, ByVal Shift as Integer)
iKeyCode = TxT_KeyDown(txbX, CInt(iKeyCode))
End Sub
'-------------------- ---------------------------
' Consenti solo ai decimali di inserire la coordinata Y
'-------------------- ---------------------------
Sub privato txbY_KeyDown (ByVal iKeyCode as MSForms.ReturnInteger, ByVal Shift as Integer)
iKeyCode = TxT_KeyDown(txbY, CInt(iKeyCode))
End Sub
'-------------------- ---------------------------
' Consenti solo ai decimali di inserire la coordinata Z
'-------------------- ---------------------------
Sub privato txbZ_KeyDown (ByVal iKeyCode as MSForms.ReturnInteger, ByVal Shift as Integer)
iKeyCode = TxT_KeyDown(txbZ, CInt(iKeyCode))
End Sub
'-------------------- ---------------------------
' Consenti solo a numeri interi di inserire il numero di copie
'-------------------- ---------------------------
Sub privato txbAnz_KeyPress(ByVal iKeyCode As MSForms.ReturnInteger)
Seleziona iKeyCode del caso
' Consenti solo numeri da 0 a 9
Casi da 48 a 57
' Ignora tutti gli altri segni
Altro caso: iCodiceChiave = 0
Seleziona fine
End Sub
- /codice#
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.
- code.py#
Opzione esplicita
Enum errori
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
Fine enum
'-------------------- ---------------------------
' Procedura per spostare e copiare le linee guida selezionate
'-------------------- ---------------------------
Sub SetGuidelines (iNr. As Integer, dNodeX, dNodeY, dNodeZ As Double)
Dim modello Come RFEM5.model
Dim app come RFEM5.Application
Dim guide come IGuideObjects
Dim linee() Come linea guida
Dim iCountAll, iCountSel, i, iAnzCopy, iGuideNo As Integer
Dim nuovaLineastrato come linea guida
In caso di errore, vai al gestore degli errori
' Ottieni l'interfaccia per RFEM
Se RFEM_open = Vero allora
Imposta app = GetObject(, "RFEM5.Application")
Altro
' Aumenta l'errore se RFEM non è aperto
Err.Raise Errors.Err_RFEM
End If
' Blocca la licenza COM e l'accesso al programma
app.LockLicense
' Ottieni l'interfaccia per il modello attivo
Se app.GetModelCount > 0 Allora
Imposta modello = app.GetActiveModel
Altro
' Aumenta l'errore se nessun modello è aperto
Err.Raise Errors.Err_Model
End If
' Ottieni l'interfaccia per le linee guida
Imposta guide = model.GetGuideObjects
' Definisce il numero delle linee guida
model.GetModelData.EnableSelections (False)
iCountAll = model.GetGuideObjects.GetGuidelineCount
Se iCountAll = 0, allora
' Aumenta l'errore se non sono disponibili linee guida
Err.Raise Errors.Err_Guideline
End If
iGuideNo = guide.GetGuideline(iCountAll - 1, AtIndex).GetData.No
' Definisci i numeri delle linee guida selezionate
model.GetModelData.EnableSelections (True)
iCountSel = model.GetGuideObjects.GetGuidelineCount
Se iCountSel > 0, allora
' Copia linee guida selezionate
guide.PrepareModifica
linee = guide.GetGuidelines()
Se iNumero > 0 Allora
Per iNo.Copy = 1 A iNr
Per i = 0 a iCountSel - 1
newLayerLine.WorkPlane = linee(i).WorkPlane
' Crea nuovo piano di lavoro se la linea guida deve essere copiata su un altro piano di lavoro
If (lines(i) .WorkPlane = PlaneXY And dNodeZ <> 0) Then
newLayerLine.WorkPlaneOrigin.Z = linee(i).WorkPlaneOrigin.Z + dNodeZ * iAnzKopie
newLayerLine.WorkPlaneOrigin.X = linee(i).WorkPlaneOrigin.X
newLayerLine.WorkPlaneOrigin.Y = linee(i).WorkPlaneOrigin.Y
ElseIf (lines(i).WorkPlane = PlaneYZ and dNodeX <> 0) Then
newLayerLine.WorkPlaneOrigin.X = lines(i).WorkPlaneOrigin.X + dNodeX * iAnzKopie
newLayerLine.WorkPlaneOrigin.Y = linee(i).WorkPlaneOrigin.Y
newLayerLine.WorkPlaneOrigin.Z = linee(i).WorkPlaneOrigin.Z
ElseIf (lines(i).WorkPlane = PlaneXZ and dNodeY <> 0) Then
newLayerLine.WorkPlaneOrigin.Y = lines(i).WorkPlaneOrigin.Y + dNodeY * iAnzKopie
newLayerLine.WorkPlaneOrigin.X = linee(i).WorkPlaneOrigin.X
newLayerLine.WorkPlaneOrigin.Z = linee(i).WorkPlaneOrigin.Z
Altro
' Linee guida nello stesso piano di lavoro
newLayerLine.WorkPlaneOrigin.X = linee(i).WorkPlaneOrigin.X
newLayerLine.WorkPlaneOrigin.Y = linee(i).WorkPlaneOrigin.Y
newLayerLine.WorkPlaneOrigin.Z = linee(i).WorkPlaneOrigin.Z
End If
newLayerLine.Type = linee(i).Type
newLayerLine.Angle = linee(i).Angolo
newLayerLine.Radius = linee(i).Radius
' Le coordinate della linea guida (X, Y, Z) della copia sono modificate dal vettore di spostamento
newLayerLine.Point1.X = lines(i).Point1.X + dNodeX * iAnzKopie
newLayerLine.Point1.Y = lines(i).Point1.Y + dNodeY * iAnzKopie
newLayerLine.Point1.Z = linee(i).Point1.Z + dNodoZ * iAnzKopie
newLayerLine.Point2.X = lines(i).Point2.X + dNodeX * iAnzKopie
newLayerLine.Point2.Y = lines(i).Point2.Y + dNodeY * iAnzKopie
newLayerLine.Point2.Z = linee(i).Point2.Z + dNodoZ * iAnzKopie
nuovaLineaStrato.No = iGuideNo + i + 1
newLayerLine.Description = "Copia linea guida " + CStr(linee(i).No)
guide.SetGuideline newLayerLine
Successivo
iCountAll = iCountAll + iCountSel
iGuideNo = guide.GetGuideline(iCountAll - 1, AtIndex).GetData.No
Successivo
' Spostamento delle linee guida selezionate
Altro
Per i = 0 a iCountSel - 1
' Spostamento delle linee guida su un altro piano di lavoro
If (lines(i) .WorkPlane = PlaneXY And dNodeZ <> 0) Then
linee(i).WorkPlaneOrigin.Z = linee(i).WorkPlaneOrigin.Z + dNodeZ
ElseIf (lines(i).WorkPlane = PlaneYZ and dNodeX <> 0) Then
linee(i).WorkPlaneOrigin.X = linee(i).WorkPlaneOrigin.X + dNodeX
ElseIf (lines(i).WorkPlane = PlaneXZ and dNodeY <> 0) Then
linee(i).WorkPlaneOrigin.Y = linee(i).WorkPlaneOrigin.Y + dNodeY
End If
' Le coordinate della linea guida (X, Y, Z) sono modificate dal vettore di spostamento
linee(i).Punto1.X = linee(i).Punto1.X + dNodoX
linee(i).Punto1.Y = linee(i).Punto1.Y + dNodoY
linee(i).Punto1.Z = linee(i).Punto1.Z + dNodoZ
linee(i).Punto2.X = linee(i).Punto2.X + dNodoX
linee(i).Punto2.Y = linee(i).Punto2.Y + dNodoY
linee(i).Punto2.Z = linee(i).Punto2.Z + dNodoZ
Successivo
guide.SetGuidelines linee
End If
guide.FinishModification
Altro
' Causa errore se non sono selezionate linee guida
Err.Raise Errors.Err_Guideline_sel
End If
' Gestione degli errori
Gestore errori:
Se Err.Number <> 0 Allora
Seleziona numero err.caso
Errori caso.Err_RFEM
MsgBox ("RFEM non è aperto")
Esci sub
Errori caso.Err_Model
MsgBox ("Nessun file aperto!")
Errori caso.Err_Guideline
MsgBox ("Nessuna linea guida disponibile nel file " & model.GetName & " !")
Errori caso.Err_Guideline_sel
MsgBox ("Nessuna linea guida selezionata nel file " & model.GetName & " !")
Caso Altro
MsgBox "Errore nr. : " & Err.Number & vbLf & Err.Description
Seleziona fine
End If
La licenza COM di ' è sbloccata, l'accesso al programma è di nuovo possibile
app.UnlockLicense
Imposta app = Niente
Set model = Nothing
Imposta guide = Niente
End Sub
'-------------------- ---------------------------
' Inizializzazione
'-------------------- ---------------------------
Sub 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() As Boolean
Dim objWMI, colPro As Object
Imposta objWMI = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & "." & "\root\cimv2")
Imposta colPro = objWMI.ExecQuery_
("Seleziona * da Win32_Process dove nome = 'RFEM64.exe'")
Se colPro.Count = 0 Allora
RFEM_open = Falso
Altro
RFEM_open = Vero
End If
Funzione finale
- /codice#
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: