UpdateValue / RemoveValue / Annotate Example

 

 

 

This example, demonstrates writing a value to a tag, providing an annotation during the write, and removing a value  at a time from a tag.  Note you can also annotate existing values by retrieving the value, adding an annotation and calling UpdateValue but this is not demonstrated in this example.  

Enter a server name, tag name, timestamp and value, then press the "Write value" button to send a value to the named PIPoint.  Checking the Qflag, results in the value having the "Questionable" bit set.  Adding text in the "Annotation" edit box will annotate the new event when the "Write value" button is pressed.  A combo box provides the parameter for controlling the handling of duplicate values.  When a value is written the List1 listbox is updated with the result. 

To remove a value, enter a Start Time and and optional End time in the middle text boxes and press the "Remove value" button.  A combo box supplies the parameter to control removal of duplicate values at at time stamp.

 

The View portion of the user interface allows retrieving values for the tag specified under the UpdateValue section given a start and end time.  This is convenient for reviewing the changes made by the other portions of the application.

 

 

Build the UpdateValue example as follows:

1. Create a new project and add references to the PISDK libraries.

2. Add the visual elements as shown in the picture above . Make sure the numbered element names (labels, text boxes, buttons) match those shown.  The buttons are as follows Command1 = "Write value", Command2 = "Fetch values" Command3 = "Remove value".  The Qflag check box is named Check1.

3. Cut and paste the code below into the project.

When run, the program will appear as follows:

 

Option Explicit
Dim srv_write As Server

Private Sub Command1_Click()
'Dim srv_write As Server
Dim ptval As PIPoint
Dim vals As New PIValues, piVal As PIValue
Dim nvAtts As New NamedValues
Dim piErr As PIErrors
On Error GoTo eMsg
  Me.MousePointer = vbHourglass
  Label6.Caption = "Connecting to " & Text1.Text
  DoEvents
  ' If we have not connected or server name has changed,
  ' connect to the server.
  If srv_write Is Nothing Then
    Set srv_write = PISDK.Servers.Item(Text1.Text)
    srv_write.Open
  ElseIf srv_write.Name <> Text1.Text Then
    Set srv_write = PISDK.Servers.Item(Text1.Text)
    srv_write.Open
  End If
  If Check1.Value <> 0 Then nvAtts.Add "questionable", 1
  If Len(Text5.Text) > 0 Then nvAtts.Add "annotations", Text5.Text
  vals.ReadOnly = False
  Set piVal = vals.Add(Text3.Text, Text4.Text, nvAtts)
  vals.ReadOnly = True
  Label6.Caption = "Writing value with " & piVal.ValueAttributes.Count
  DoEvents
  Set ptval = srv_write.PIPoints.Item(Text2.Text)
  Set piErr = ptval.Data.UpdateValues(vals, GetdmMode(Combo1))
  If Not piErr Is Nothing Then
    If piErr.Count > 0 Then
      Err.Description = "Received " & piErr.Count & " error: " & _
        piErr.Item(1).Description
      Err.Raise -1, "UpdateValues", Err.Description
    End If
  End If
  ' Check for valid time range
  If Len(Text11.Text) > 0 Then
  Else
    Dim piTfmt As New PITimeFormat
    ' Need to generate a range
    piTfmt.InputString = Text3.Text
    Text11.Text = CStr(piTfmt.AddIntervals("m", -1))
    Text12.Text = CStr(piTfmt.AddIntervals("m", 1))
  End If
  ' Refill list box.
  Call Command2_Click
      
  Label6.Caption = "Success"
  Me.MousePointer = vbDefault
  Exit Sub
eMsg:
Me.MousePointer = vbDefault
Label6.Caption = Err.Description
End Sub

Private Sub Command2_Click()
  Call ListRecVals(Text1.Text, Text2.Text, Text11.Text, Text12.Text)
End Sub

Private Sub ListRecVals(txtSrv As String, txtTag As String, _
            vtStart, vtEnd)
Dim ptval As PIPoint, ptData As PIData
Dim piv As PIValue, piVals As PIValues
On Error GoTo eMsg
  Me.MousePointer = vbHourglass
  Label6.Caption = "Connecting to " & txtSrv
  DoEvents
  ' If we have not connected or server name has changed,
  ' connect to the server.
  If srv_write Is Nothing Then
    Set srv_write = PISDK.Servers.Item(txtSrv)
    srv_write.Open
  ElseIf srv_write.Name <> Text1.Text Then
    Set srv_write = PISDK.Servers.Item(txtSrv)
    srv_write.Open
  End If
  
  Set ptData = srv_write.PIPoints.Item(txtTag).Data
On Error Resume Next
    ptData.RetrievalAttributes.Add "questionable", 1
    ptData.RetrievalAttributes.Add "substituted", 1
    ptData.RetrievalAttributes.Add "annotated", 1
    ptData.RetrievalAttributes.Add "annotations", 1
On Error GoTo eMsg
  
  Set piVals = ptData.RecordedValues(vtStart, vtEnd, btInside)
  List1.Clear
  Dim strTmp As String
  For Each piv In piVals
     Dim nvcol As NamedValues
     Dim a_val As NamedValue
     Set nvcol = piv.ValueAttributes
     strTmp = CStr(piv.TimeStamp.LocalDate) & " | " & CStr(piv.Value)
On Error Resume Next
     If nvcol.Count > 0 Then
       strTmp = strTmp & " |"
       Set a_val = nvcol("Substituted")
       If Err.Number = 0 Then
         If a_val.Value Then strTmp = strTmp & " S"
       End If
       Set a_val = nvcol("questionable")
       If Err.Number = 0 Then
         If a_val.Value Then strTmp = strTmp & " Q"
       End If
       Set a_val = nvcol("Annotated")
       If Err.Number = 0 Then
         If a_val.Value Then _
         strTmp = strTmp & " A," & CStr(nvcol("annotations").Value)
       End If
       If Err.Number <> 0 Then _
         Err.Raise Err.Number, , Err.Description
     End If
On Error GoTo eMsg
      List1.AddItem strTmp
  Next
  If List1.ListCount > 0 Then List1.ListIndex = 0
  
  Label6.Caption = "Success"
  Me.MousePointer = vbDefault
  Exit Sub
eMsg:
Me.MousePointer = vbDefault
Label6.Caption = Err.Description
End Sub

Private Sub Command3_Click()
Dim ptval As PIPoint
On Error GoTo eMsg
  Me.MousePointer = vbHourglass
  Label6.Caption = "Connecting to " & Text1.Text
  DoEvents
  ' If we have not connected or server name has changed,
  ' connect to the server.
  If srv_write Is Nothing Then
    Set srv_write = PISDK.Servers.Item(Text1.Text)
    srv_write.Open
  ElseIf srv_write.Name <> Text1.Text Then
    Set srv_write = PISDK.Servers.Item(Text1.Text)
    srv_write.Open
  End If
  Set ptval = srv_write.PIPoints.Item(Text2.Text)
  ptval.Data.RemoveValues Text8.Text, Text9.Text, GetDRmode(Combo2)
  
  ' Check for valid time range
  ' Refill list box.
  Call Command2_Click
  
  Label6.Caption = "Success"
  Me.MousePointer = vbDefault
  Exit Sub
eMsg:
Me.MousePointer = vbDefault
Label6.Caption = Err.Description
End Sub

Private Sub Form_Load()
Label6.Caption = ""
Text1.Text = "localhost"
Text2.Text = "sinusoid"
Text3.Text = "*"
Text4.Text = "98"
Text5.Text = ""
Text8.Text = "*"
Text9.Text = ""
Text11.Text = ""
Text12.Text = ""
PrepDMconst Combo1
PrepDRconst Combo2
End Sub
Private Sub PrepDMconst(CB As ComboBox)
CB.AddItem "dmReplaceDuplicates"
CB.AddItem "dmReplaceOnlyDuplicates"
CB.AddItem "dmErrorDuplicates"
CB.AddItem "dmInsertDuplicates"
CB.ListIndex = 0
End Sub
Private Function GetdmMode(CB As ComboBox) As PISDK.DataMergeConstants
GetdmMode = Switch( _
CB.Text = "dmReplaceDuplicates", PISDK.DataMergeConstants.dmReplaceDuplicates, _
CB.Text = "dmReplaceOnlyDuplicates", PISDK.DataMergeConstants.dmReplaceOnlyDuplicates, _
CB.Text = "dmErrorDuplicates", PISDK.DataMergeConstants.dmErrorDuplicates, _
CB.Text = "dmInsertDuplicates", PISDK.DataMergeConstants.dmInsertDuplicates)
End Function
Private Sub PrepDRconst(CB As ComboBox)
CB.AddItem "drRemoveAll"
CB.AddItem "drRemoveFirstOnly"
CB.ListIndex = 0
End Sub
Private Function GetDRmode(CB As ComboBox) As PISDK.DataRemovalConstants
GetDRmode = Switch( _
CB.Text = "drRemoveAll", PISDK.DataRemovalConstants.drRemoveAll, _
CB.Text = "drRemoveFirstOnly", PISDK.DataRemovalConstants.drRemoveFirstOnly)
End Function


 

Enabling Operational Intelligence