Hallo zusammen,
nachdem ich bei meinem ersten Problem hier sehr schnell Hilfe gefunden habe und mittlerweile auch fleißig mit LabView spiele, würde ich gerne ein weiteres Projekt angehen.
Es geht um zwei Ultraschallsensoren, welche zur Messung von Entfernungen (zwischen 2 und 4cm) eingesetzt werden. Die beiden Sensoren (
UC4-1354B) sind an einem (
Gateway angebunden, welches per LAN-Kabel am Rechner hängt. Die Messwerte werden wie folgt abgerufen: Firefox--> Webserver (192.168.0.1) aufrufen --> zum Sensor durchs Menü "durchklicken" (Java)-->Werte erscheinen.
Ich habe eine Excel mit Makro erhalten, welche mir den Messwert in Excel pollt, ohne dass man die o.g. Schritte durchführen muss.
Ziel ist es im Idealfall alles über eine VI laufen zu lassen (Temperatur aus meinem ersten Thread und dann eben die Distanzsensoren). Am elegantesten wäre es natürlich, wenn man die Excel garnicht mehr "manuell" öffnen/starten muss sondern alles über ein und dieselbe VI bedienen/ablesen kann.
Später wird das Ganze dann sukzessive erweitert (z.B. Einbindung von Schichtdickenmesssensoren, temperaturgesteuerte Regelung der Infrarotstrahler etc).
Im Anhang befindet sich die besagte Excel Datei. Ein Screenshot der Excel sowie der Code von den Makros habe ich beigefügt. (.xlsm-Dateien lassen sich hier leider nicht hochladen). Bei "Port" kann entweder Sensor1 (Port 1) oder Sensor2 (Port 2) ausgewählt werden. Die wirkliche Distanz wird dann über die ersten 3 Zahlen in Zelle B8 berechnet und in B15 als Endergebnis ausgegeben.
Code:
Option Explicit
Sub StartPolling()
If Worksheets(1).Buttons("Button_PollPD").Caption = "Start polling" Then
Worksheets(1).Buttons("Button_PollPD").Caption = "End polling"
Call StartQuery(Cells(2, 2), Cells(3, 2), Worksheets(1))
Else
Worksheets(1).Buttons("Button_PollPD").Caption = "Start polling"
StopQuery
End If
End Sub
Code:
Dim timerActive As Boolean
Dim ipAddress As String
Dim activePort As String
Dim currentSheet As Worksheet
Private Sub ParseProcessdataJSON(data As String)
Dim scriptControl As Object
Dim json As Object
Set scriptControl = CreateObject("MSScriptControl.ScriptControl")
scriptControl.Language = "JScript"
Set json = scriptControl.Eval("(" + data + ")")
With currentSheet
Dim dataObj As Object
Set dataObj = CallByName(json, "data", VbGet)
.Cells(8, 3) = CallByName(dataObj, "isValid", VbGet)
Set processdatainObj = CallByName(dataObj, "processDataIn", VbGet)
Dim arrayLength As Variant
arrayLength = CInt(CallByName(processdatainObj, "length", VbGet))
Dim strPD As String
For i = 0 To arrayLength - 1
strPD = strPD + CStr(CallByName(processdatainObj, CStr(i), VbGet))
If i < arrayLength - 1 Then
strPD = strPD + ", "
End If
Next
.Cells(8, 2) = strPD
End With
End Sub
Private Sub QueryRESTProcessData()
Dim objRequest As Object
Dim strUrl As String
Dim strResponse As String
Dim strBody As String
Dim portNo As Variant
Set objRequest = CreateObject("MSXML2.XMLHTTP")
strUrl = "http://" + ipAddress + "/iolink/sickv1/readPort"
portNo = CInt(activePort) - 1
strBody = "{""header"":{""portNumber"":" + CStr(portNo) + "},""data"":{""processData"":""in""}}"
With objRequest
.Open "POST", strUrl, False
.SetRequestHeader "Content-Type", "application/json"
.SetRequestHeader "Accept", "application/json" ''Content-Type: application/json'
.Send (strBody)
strResponse = .ResponseText
End With
Debug.Print strResponse
Call ParseProcessdataJSON(strResponse)
currentSheet.Cells(8, 1) = "Port " + activePort
If (timerActive = True) Then
Application.OnTime Now() + TimeValue("00:00:01"), "QueryRESTProcessData"
End If
End Sub
Sub StartQuery(ipAddr, port, sheet As Worksheet)
ipAddress = ipAddr
activePort = port
Set currentSheet = sheet
timerActive = True
Application.OnTime Now() + TimeValue("00:00:01"), "QueryRESTProcessData"
End Sub
Sub StopQuery()
timerActive = False
End Sub
Wie würdet ihr an die Sache ran gehen? Freue mich über jeden Tipp/Hinweis
Vielen Dank im Voraus und viele liebe Grüße
Christian
