Interfejs COM w VBA | 5. Tworzenie narzędzia do kopiowania i przesuwania linii pomocniczych

Wstawianie łącza

Najpierw należy zintegrować bibliotekę obiektów RFEM z edytorem VBA, wybierając kolejno opcje „Narzędzia” → „Referencje”.

Zintegruj bibliotekę typów Dlubal RFEM

Tabela wejściowa

Wektor przemieszczenia oraz liczbę kopii należy wprowadzić do tabeli wprowadzania. Aby utworzyć tabelę danych wejściowych, w edytorze VBA zostanie utworzony formularz użytkownika wskazujący na „Wstawić” -> „UserForm”. Niezbędne elementy sterujące zostaną umieszczone w formularzu użytkownika. W tym celu w przyborniku należy wybrać odpowiednie ustawienie, a następnie zapisać je 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.

Maska wprowadzania

Jako dane wejściowe należy zezwolić tylko na ułamki dziesiętne w przypadku wektora przemieszczenia i tylko liczby całkowite w przypadku liczby kopii. Kod źródłowy tabeli wprowadzania danych znajduje się poniżej.

Opcja Jawna

„------------------------------------------------- -------------------------
'Zamknąć okno po kliknięciu Anuluj
„------------------------------------------------- -------------------------
Private Sub cmdClose_Click ()
frmGuideline.Hide
End Sub

„------------------------------------------------- -------------------------
'Otworzyć procedurę przenoszenia/kopiowania linii pomocniczych i zamknąć okno po kliknięciu OK
„------------------------------------------------- -------------------------
Private Sub cmdOK_Click ()
If txbAnz.Value = "" Zatem
txbAnz.Value =

Maska wprowadzania

„------------------------------------------------- -------------------------
'Funkcja pozwalająca na stosowanie tylko miejsc dziesiętnych
„------------------------------------------------- -------------------------
Funkcja prywatna TxT_KeyDown (objTextBox As MSForms.TextBox, iKeyCode Jako liczba całkowita)Jako liczba całkowita
Wybierz Wielkość liter iKeyCode
„Dopuszczalne są następujące znaki:
'8 Klawisz Backspace do poprawienia
„48–57 Liczby od 0 do 9
'96-105 Numery od 0 do 9 (klawiatura numeryczna)
'37, 39 Klawisze kursora ()
'46 Del klucz
Przypadek 48 To 57,8,96 To 105,37,39,46: TxT_KeyDown = iKeyCode
„Na pierwszej pozycji może być dopuszczony tylko jeden znak minus
'109 Minus (klawiatura numeryczna)
„189 Minus
Przypadek 109,189:
If InStr (1, objTextBox, "-", vbTextCompare)> 0 Lub objTextBox.SelStart <> 0 Więc
TxT_KeyDown = 0
Else
TxT_KeyDown = 109
End If
'Dopuścić tylko jeden przecinek lub punkt i zastąpić punkt przecinkiem
„188 Przecinek
„110 Przecinek (Nummernblock)
„190 punkt
Przypadek 190,188,110:
If InStr (1, objTextBox, ",", vbTextCompare)> 0 Lub objTextBox.SelStart = 0 Więc
TxT_KeyDown = 0
Else
TxT_KeyDown = 188
End If
Zignorować wszystkie pozostałe znaki
Przypadek inny: TxT_KeyDown = 0
Koniec Wybierz
Funkcja końca

„------------------------------------------------- -------------------------
'Zezwalają tylko na dziesiętne wprowadzanie współrzędnej X.
„------------------------------------------------- -------------------------
Private Sub txbX_KeyDown (ByVal iKeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
iKeyCode = TxT_KeyDown (txbX, CInt (iKeyCode))
End Sub

„------------------------------------------------- -------------------------
'Zezwalaj tylko na dziesiętne wprowadzanie współrzędnej Y.
„------------------------------------------------- -------------------------
Private Sub txbY_KeyDown (ByVal iKeyCode As MSForms.ReturnInteger, ByVal PrzesunięcieJako liczba całkowita)
iKeyCode = TxT_KeyDown (txbY, CInt(iKeyCode))
End Sub

„------------------------------------------------- -------------------------
'Zezwalają tylko na dziesiętne wprowadzanie współrzędnej Z.
„------------------------------------------------- -------------------------
Private Sub txbZ_KeyDown (ByVal iKeyCode As MSForms.ReturnInteger, ByVal PrzesunięcieJako liczba całkowita)
iKeyCode = TxT_KeyDown (txbZ, CInt(iKeyCode))
End Sub

„------------------------------------------------- -------------------------
'W liczbach całkowitych można wprowadzać tylko liczby całkowite
„------------------------------------------------- -------------------------
Private Sub txbAnz_KeyPress (ByVal iKeyCode As MSForms.ReturnInteger)
Wybierz Wielkość liter iKeyCode
'Dopuszczalne są tylko liczby od 0 do 9
Przypadek 48 To 57
Zignorować wszystkie pozostałe znaki
Przypadek inny: iKeyCode = 0
Koniec Wybierz
End Sub

Wskazówki dotyczące przenoszenia i kopiowania

Kod źródłowy do przenoszenia i kopiowania wybranych linii pomocniczych znajduje się poniżej. Pojedyncze kroki wyjaśniono w komentarzach.

Opcja Jawna

Enum Błędy i ostrzeżenia
Err_RFEM = 513 „Program RFEM nie otwarty
Err_Model = 514 „Nie otwarto żadnego modelu
Err_Guideline = 515 „Brak dostępnych wytycznych
Err_Guideline_sel = 516 „Nie wybrano linii pomocniczych
End Enum

„------------------------------------------------- -------------------------
„Procedura przenoszenia i kopiowania wybranych linii pomocniczych
„------------------------------------------------- -------------------------
Sub SetGuidelines (iAnz Jako liczba całkowita, dNodeX, dNodeY, dNodeZ As Double)
Dim model As RFEM5.model
Dim ok As RFEM5.Aplikacja
Dim przewodniki As IGuideObjects
Dim linie () As Wytyczna
Dim iCountAll, iCountSel, i, iAnzKopie, iGuideNo Jako liczba całkowita
Dim newLayerLine As Wytyczna

On Error GoTo ErrorHandler

Uzyskaj interfejs do programu RFEM
If RFEM_open = Prawda wtedy
Ustawić app = GetObject (, "RFEM5.Application")
Else
„Podnieść błąd, jeżeli program RFEM nie jest otwarty
Err.Raise Errors.Err_RFEM
End If

'Blokować dostęp do licencji COM i programów
app.LockLicense

'Uzyskaj interfejs dla aktywnego modelu
If app.GetModelCount> 0 Więc
Ustawić model = app.GetActiveModel
Else
„Podnieść błąd, jeżeli żaden model nie jest otwarty
Err.Raise Errors.Err_Model
End If

'Uzyskaj interfejs dla wskazówek
Ustawić prowadnice = model.GetGuideObjects

„Zdefiniować liczbę linii pomocniczych
model.GetModelData.EnableSelectionsFałsz)
iCountAll = model.GetGuideObjects.GetGuidelineCount
If iCountAll = 0 Więc
„Podnieść błąd, jeżeli nie są dostępne żadne wytyczne
Err.Raise Errors.Err_Guideline
End If
iGuideNo = guide.GetGuideline (iCountAll - 1, AtIndex) .GetData.No

'Zdefiniować numery wybranych linii pomocniczych
model.GetModelData.EnableSelectionsPrawda)
iCountSel = model.GetGuideObjects.GetGuidelineCount

If iCountSel> 0 Więc
'Skopiować wybrane linie pomocnicze
Guide.PrepareModification
Linie = Linie pomocnicze.GetGuidelines ()
If iAnz> 0 Więc
Jeżeli chcesz zadać krótkie pytanie techniczne, iAnzKopie = 1 To iAnz
Jeżeli chcesz zadać krótkie pytanie techniczne, i = 0 To iCountSel - 1
newLayerLine.WorkPlane = linie (i) .WorkPlane
„Utworzyć nową płaszczyznę roboczą, jeżeli linia pomocnicza ma zostać skopiowana do innej płaszczyzny roboczej
If (linie (i) .WorkPlane = PłaszczyznaXY I dNodeZ <>

Maska wprowadzania

End Sub

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

„------------------------------------------------- -------------------------
'Funkcja umożliwiająca sprawdzenie, czy program RFEM jest otwarty
„------------------------------------------------- -------------------------
Funkcja RFEM_open () As Boolean
Dim objWMI, colPro Jako obiekt

Ustawić objWMI = GetObject ("winmgmts:" _
& "{impersonationLevel = personifikacja}! \\" & "." & "\ root \ cimv2")
Ustawić colPro = objWMI.ExecQuery _
("Wybrać * z Win32_Process Where Name = 'RFEM64.exe'")
If colPro.Count = 0 Więc
RFEM_open = Fałsz
Else
RFEM_open = Prawda
End If
Funkcja końca

Podsumowanie i perspektywy

W artykule opracowano narzędzie do przenoszenia/kopiowania linii pomocniczych w programie RFEM. W ten sam sposób można utworzyć odpowiednie narzędzie dla programu RSTAB. Narzędzie jest uruchamiane za pomocą interfejsu Excel. Narzędzie to można zintegrować z programem RFEM lub RSTAB w sposób opisany w tym artykule.