Wstawianie odniesienia
Bibliotekę obiektów RFEM należy najpierw zintegrować z edytorem VBA, wybierając kolejno opcje "Narzędzia" → "Referencje".
maski wprowadzania
W tabeli danych wejściowych należy wprowadzić wektor przemieszczenia oraz liczbę kopii. Aby utworzyć tabelę wejściową, należy wygenerować formularz użytkownika poprzez wybranie w edytorze VBA opcji "Wstawić" → "Formularz użytkownika". Niezbędne kontrolki zostaną umieszczone w formularzu użytkownika. W tym celu należy wybrać odpowiednią kontrolkę w przyborniku, a następnie zapisać ją w formularzu użytkownika. Właściwości, takie jak rozmiar, położenie, nazwa formularza użytkownika i elementy sterujące można zdefiniować w oknie właściwości.
Jako dane wejściowe mogą być dozwolone tylko liczby dziesiętne dla wektora przemieszczenia i tylko liczby całkowite określające liczbę kopii. Kod źródłowy tabeli danych wejściowych znajduje się poniżej.
- kod.py#
Opcja bezpośrednia
'------------------------------------------ ---------------------------
' Zamknij okno po kliknięciu przycisku Anuluj
'------------------------------------------ ---------------------------
Prywatne polecenie cmdClose_Click ()
frmGuideline.Hide
End Sub
'------------------------------------------ ---------------------------
' Otwarcie procedury przesuwania/kopiowania linii pomocniczych i zamykanie okna po kliknięciu OK
'------------------------------------------ ---------------------------
Prywatne cmdOK_Click ()
If txbNum.Value = "" Wtedy
txbLiczba.Wartość = 0
End If
If txbX.Value = "" Wtedy
txbX.Value = 0
End If
If txbY.Value = "" Wtedy
txbY.Value = 0
End If
If txbZ.Value = "" Wtedy
txbZ.Wartość = 0
End If
modGuideline.SetGuidelines(txbAnz.Value, txbX.Value, txbY.Value, txbZ.Value)
frmGuideline.Hide
End Sub
'------------------------------------------ ---------------------------
' Funkcja umożliwiająca stosowanie tylko liczb dziesiętnych
'------------------------------------------ ---------------------------
Funkcja prywatna TxT_KeyDown(objTextBox As MSForms.TextBox, iKeyCode As Integer) As Integer
Wybierz iKeyCode przypadku
' Uwzględnij następujące znaki:
' 8 Klawisz Backspace do poprawienia
' 48-57 Liczby od 0 do 9
' 96-105 Liczby od 0 do 9 (klawiatura numeryczna)
' 37, 39 Klawisze kursora ()
' 46 Del, klawisz
Przypadek 48 do 57, 8, 96 do 105, 37, 39, 46: TxT_KeyDown = iKeyCode
' Dopuść tylko jeden znak minus na pierwszej pozycji
' 109 Minus (klawiatura numeryczna)
' 189 minus
Przypadek 109, 189:
If InStr(1, objTextBox, "-", vbTextCompare) > 0 Lub objTextBox.SelStart <> 0 Wtedy
TxT_Klucz w dół = 0
Else
TxT_Skrót_w dół = 109
End If
' Dopuść tylko jeden przecinek lub punkt i zastąp punkt przecinkiem
' 188 przecinek
' 110 Przecinek (Nummernblock)
' 190 Punkt
Przypadek 190, 188, 110:
If InStr(1, objTextBox, , vbTextCompare) > 0 Lub objTextBox.SelStart = 0 Then
TxT_Klucz w dół = 0
Else
TxT_Skrót_w dół = 188
End If
' Ignoruj wszystkie pozostałe znaki
Inny przypadek: TxT_Klucz w dół = 0
Koniec wyboru
Funkcja końca
'------------------------------------------ ---------------------------
' Współrzędnej X mogą być wprowadzane tylko liczby dziesiętne
'------------------------------------------ ---------------------------
Private Sub txbX_KeyDown (ByVal iKeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
iKeyCode = TxT_KeyDown (txbX, CInt(iKeyCode))
End Sub
'------------------------------------------ ---------------------------
' Współrzędna Y może być wprowadzana tylko ułamkowo
'------------------------------------------ ---------------------------
Private Sub txbY_KeyDown (ByVal iKeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
iKeyCode = TxT_KeyDown (txbY, CInt(iKeyCode))
End Sub
'------------------------------------------ ---------------------------
' Zezwól na wprowadzanie współrzędnych Z tylko ułamków dziesiętnych
'------------------------------------------ ---------------------------
Private Sub txbZ_KeyDown (ByVal iKeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
iKeyCode = TxT_KeyDown (txbZ, CInt(iKeyCode))
End Sub
'------------------------------------------ ---------------------------
' Liczbę kopii można wprowadzać tylko jako liczby całkowite
'------------------------------------------ ---------------------------
Private Sub txbAnz_KeyPress(ByVal iKeyCode As MSForms.ReturnInteger)
Wybierz iKeyCode przypadku
' Dozwolone tylko liczby z zakresu 0-9
Przypadek 48 do 57
' Ignoruj wszystkie pozostałe znaki
Inny przypadek: iKeyCode = 0
Koniec wyboru
End Sub
- /kod#
Przenoszenie i kopiowanie linii pomocniczych
Poniżej znajduje się kod źródłowy do przeniesienia i skopiowania wybranych linii pomocniczych. Poszczególne kroki są wyjaśnione w komentarzach.
- kod.py#
Opcja bezpośrednia
Błędy wyliczenia
Err_RFEM = 513 ' RFEM nie został otwarty
Err_Model = 514 ' Nie otwarto żadnego modelu
Err_Guideline = 515 ' Brak dostępnej linii pomocniczej
Err_Guideline_sel = 516 ' Nie wybrano żadnych linii pomocniczych
Końcowe wyliczenie
'------------------------------------------ ---------------------------
' Procedura przesuwania i kopiowania wybranych linii pomocniczych
'------------------------------------------ ---------------------------
Subzbiórlinii pomocniczych (iNo. As Integer, dNodeX, dNodeY, dNodeZ As Double)
Dim model As RFEM5.model
Aplikacja Dim As RFEM5.Application
Przyciemnij linie pomocnicze jako IGuideObjects
Przyciemnij linie () Jako wskazówka
Dim iCountAll, iCountSel, i, iAnzCopy, iGuideNo As Integer
Dim newLayerLine As Guideline
W przypadku błędu Przejdź do modułu obsługi błędu
' Pobierz interfejs z RFEM
Jeżeli RFEM_open = True To
Set app = GetObject(, "RFEM5.Application")
Else
' Zgłoś błąd, jeśli program RFEM nie jest otwarty
Err.Raise Errors.Err_RFEM
End If
' Blokowanie licencji COM i dostępu do programu
app.LockLicense
' Pobierz interfejs dla aktywnego modelu
Jeżeli app.GetModelCount > 0 Wtedy
Zdefiniuj model = app.GetActiveModel
Else
' Zgłoś błąd, jeśli nie jest otwarty żaden model
Err.Raise Errors.Err_Model
End If
' Pobierz interfejs z liniami pomocniczymi
Ustaw linie pomocnicze = model.GetGuideObjects
' Zdefiniuj numery linii pomocniczych
model.GetModelData.EnableSelections (False)
iCountAll = model.GetGuideObjects.GetGuidelineCount
Jeżeli iCountAll = 0, to
' Zgłoś błąd w przypadku braku linii pomocniczych
Err.Raise Errors.Err_Guideline
End If
iGuideNo = guides.GetGuideline(iCountAll - 1, AtIndex).GetData.No
' Zdefiniuj numery wybranych linii pomocniczych
model.GetModelData.EnableSelections (True)
iCountSel = model.GetGuideObjects.GetGuidelineCount
Jeżeli iCountSel > 0, to
' Kopiuj wybrane linie pomocnicze
guides.PrepareModification
lines = lines.GetGuidelines ()
Jeżeli iNumber > 0 To
Dla iNo.Copy = 1 Do iNo
Dla i = 0 To iCountSel - 1
newLayerLine.WorkPlane = lines(i).WorkPlane
' Utworzyć nową płaszczyznę roboczą, jeżeli linia pomocnicza ma zostać skopiowana do innej płaszczyzny roboczej
Jeżeli (linie (i) .WorkPlane = PlaneXY and dNodeZ <> 0) Wtedy
newLayerLine.WorkPlaneOrigin.Z = lines(i).WorkPlaneOrigin.Z + dNodeZ * iAnzKopie
newLayerLine.WorkPlaneOrigin.X = lines(i).WorkPlaneOrigin.X
newLayerLine.WorkPlaneOrigin.Y = lines(i).WorkPlaneOrigin.Y
InaczejJeżeli (linie(i).Płaszczyznarobocza = PlaneYZ and dNodeX <> 0) Wtedy
newLayerLine.WorkPlaneOrigin.X = lines(i).WorkPlaneOrigin.X + dNodeX * iAnzKopie
newLayerLine.WorkPlaneOrigin.Y = lines(i).WorkPlaneOrigin.Y
newLayerLine.WorkPlaneOrigin.Z = lines(i).WorkPlaneOrigin.Z
InaczejJeżeli (linie(i).Płaszczyzna robocza = PlaneXZ i dNodeY <> 0) Wtedy
newLayerLine.WorkPlaneOrigin.Y = lines(i).WorkPlaneOrigin.Y + dNodeY * iAnzKopie
newLayerLine.WorkPlaneOrigin.X = lines(i).WorkPlaneOrigin.X
newLayerLine.WorkPlaneOrigin.Z = lines(i).WorkPlaneOrigin.Z
Else
' Linie pomocnicze w tej samej płaszczyźnie roboczej
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 = linie(i).Angle
newLayerLine.Radius = linie(i).Radius
' Współrzędne linii pomocniczej (X, Y, Z) kopii są dostosowywane przez wektor przemieszczenia
newLayerLine.Point1.X = lines(i).Point1.X + dNodeX * iAnzKopie
newLayerLine.Point1.Y = lines(i).Point1.Y + dNodeY * iAnzKopie
newLayerLine.Point1.Z = linie(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 = linie(i).Point2.Z + dNodeZ * iAnzKopie
nowaLiniawarstwy.nr = iGuideNo + i + 1
newLayerLine.Description = "Kopiuj linię pomocniczą " + CStr(lines(i).No)
guides.SetGuideline newLayerLine
Następny
iCountAll = iCountAll + iCountSel
iGuideNo = guides.GetGuideline(iCountAll - 1, AtIndex).GetData.No
Następny
' Przenoszenie wybranych linii pomocniczych
Else
Dla i = 0 To iCountSel - 1
' Przenoszenie linii pomocniczych na inną płaszczyznę roboczą
Jeżeli (linie (i) .WorkPlane = PlaneXY and dNodeZ <> 0) Wtedy
lines(i).WorkPlaneOrigin.Z = lines(i).WorkPlaneOrigin.Z + dNodeZ
InaczejJeżeli (linie(i).Płaszczyznarobocza = PlaneYZ and dNodeX <> 0) Wtedy
lines(i).WorkPlaneOrigin.X = lines(i).WorkPlaneOrigin.X + dNodeX
InaczejJeżeli (linie(i).Płaszczyzna robocza = PlaneXZ i dNodeY <> 0) Wtedy
lines(i).WorkPlaneOrigin.Y = lines(i).WorkPlaneOrigin.Y + dNodeY
End If
' Współrzędne linii pomocniczej (X, Y, Z) są dostosowywane przez wektor przemieszczenia
linie(i).Punkt1.X = linie(i).Punkt1.X + dNodeX
linie(i).Punkt1.Y = linie(i).Punkt1.Y + dNodeY
linie(i).Punkt1.Z = linie(i).Punkt1.Z + dNodeZ
linie(i).Punkt2.X = linie(i).Punkt2.X + dWęzełX
linie(i).Punkt2.Y = linie(i).Punkt2.Y + dNodeY
linie(i).Punkt2.Z = linie(i).Punkt2.Z + dWęzełZ
Następny
prowadnice.Ustaw linie pomocnicze
End If
guides.FinishModification
Else
' Powoduje błąd, jeśli nie wybrano linii pomocniczych
Err.Raise Errors.Err_Guideline_sel
End If
' Obsługa błędów
Obsługa błędów:
Jeżeli Err.Number <> 0 Wtedy
Wybierz przypadek błędu.Numer
Przypadek Errors.Err_RFEM
MsgBox („RFEM nie jest otwarty”)
Wyjście z Sub
Przypadek Errors.Err_Model
MsgBox („Nie otworzono żadnego pliku!”)
Przypadek Errors.Err_Guideline
MsgBox ("W pliku " & model.GetName & " !")
Obserwacja błędów.Err_Guideline_sel
MsgBox ("W pliku " nie wybrano linii pomocniczych & model.GetName & " !")
Przypadek inny
MsgBox "Błąd nr : " & Err.Number & vbLf & Err.Description
Koniec wyboru
End If
' Licencja COM jest odblokowana, dostęp do programu jest możliwy
app.UnlockLicense
Ustaw aplikację = Nic
Zdefiniuj model = Nic
Ustaw linie pomocnicze = Nic
End Sub
'------------------------------------------ ---------------------------
' Inicjalizacja
'------------------------------------------ ---------------------------
Sub init ()
frmGuideline.txbX.Value = "0"
frmGuideline.txbY.Value = "0"
frmGuideline.txbZ.Value = "0"
frmGuideline.txbAnz.Value = "0"
End Sub
'------------------------------------------ ---------------------------
' Funkcja sprawdzająca, czy program RFEM jest otwarty
'------------------------------------------ ---------------------------
Funkcja RFEM_open () jako Boolean
Dim objWMI, colPro As Object
Ustaw obiektWMI = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & "." & "\root\cimv2")
Ustaw colPro = objWMI.ExecQuery_
(„Wybierz * z Win32_Process Gdzie nazwa = 'RFEM64.exe'”)
If colPro.Count = 0 Wtedy
RFEM_open = Fałsz
Else
RFEM_open = Prawda
End If
Funkcja końca
- /kod#
Podsumowanie i perspektywy
W artykule opisano narzędzie do przenoszenia/kopiowania linii pomocniczych w programie RFEM. Odpowiednie narzędzie dla programu RSTAB można utworzyć w ten sam sposób. Narzędzie jest uruchamiane za pomocą interfejsu programu Excel. Można również zintegrować to narzędzie z programem RFEM lub RSTAB w sposób opisany w tym artykule: