PEAK-System Forum

Code: Select all

'------------------------------------------------------------------------------
'FILE DESCRIPTION: Simple PE5 script to send 4 CAN Messages with different Interval 
'------------------------------------------------------------------------------
Sub SimpleMsg_Cnt()
'DESCRIPTION: Rest Bus msg counter
    Dim UseConn, conn
  ' Find the first enabled connection in the project that uses the CAN protocol
  Set UseConn = Nothing
  For Each conn In Connections
    If conn.IsEnabled And conn.Protocol = peProtocolCAN Then
      Set UseConn = conn
      Exit For
    End If
  Next 
  If UseConn Is Nothing Then
    MsgBox "Project does not contain any enabled CAN connections"
    Exit Sub
  End If

  ' Create a new client and connect it to the same Net that the
  '  found connection uses
  Dim MyClient, PcanConn
  Set MyClient = CreateObject("PCAN3.PCANClient")
  MyClient.Device = UseConn.Device
  MyClient.Name = "PCANLight_USB_16"
  Set PcanConn = MyClient.Connections.Add(UseConn.CommunicationObject.NetName)

  Dim counter1, counter2, counter3, counter4
  Dim loopcounter
  Dim i,j,k,l
  ' Now create and initialize a new transmit message
  Dim msg,msg1,msg2,msg3
  Set msg= MyClient.Messages.Add
  Set msg1 = MyClient.Messages.Add
  Set msg2= MyClient.Messages.Add
  Set msg3= MyClient.Messages.Add
  
  timestamp = MyClient.GetSystemTime
  
  With msg
    .ID = &H27A									
    .DLC = 7
    .Data(0) = &H01
    .Data(1) = &H02
    .Data(2) = &H04
    .Data(3) = &H08
    .Data(4) = &H10
    .Data(5) = &H20
    .Data(6) = &H40
  End With
    
  With msg1
    .ID = &H4EA
    .DLC = 8
    .Data(0) = &H01
    .Data(1) = &H02
    .Data(2) = &H03
    .Data(3) = &H04
    .Data(4) = &H05
    .Data(5) = &H06
    .Data(6) = &H07
    .Data(7) = &H08
  End With
  
  With msg2
    .ID = &H37A									
    .DLC = 5
    .Data(0) = &H01
    .Data(1) = &H02
    .Data(2) = &H03
    .Data(3) = &H04
    .Data(4) = &H05
  End With
    
  With msg3
    .ID = &H3EA
    .DLC = 8
    .Data(0) = &H10
    .Data(1) = &H20
    .Data(2) = &H30
    .Data(3) = &H40
    .Data(4) = &H50
    .Data(5) = &H60
    .Data(6) = &H70
    .Data(7) = &H80
  End With
  
 i=0
 j=0
 k=0
 l=0
   
 do
 	loopcounter=loopcounter+1
 	' // 20ms 
 	i=i+1
  	msg.Data(5) = i							'//Initializing the byte 5 with message counter for message1							
  	If i>15 then i=0 End If
    msg.Data(6) = msg1.Data(0)+msg1.Data(1)+msg1.Data(2)+msg1.Data(3)+ msg1.Data(4)+msg1.Data(5) '//Implementing a simple CheckSum
    msg.Write PcanConn, timestamp				'//Transmitting data into CAN bus at Cycletime= 20 ms
    
    counter1=counter1+1
    If(counter1=2)Then
    	j=j+1
        msg1.Data(1) = j							'//Initializing the byte 1 with message counter for message1						
        if j>255 then j=0 End If
    	msg1.Write PcanConn, timestamp				'//Transmitting data into CAN bus at Cycletime= 40 ms
    	counter1=0
    End If
    
    counter2=counter2+1
    If(counter2=4)Then
     	k=k+1
		msg2.Data(2) = k							'//Initializing the byte 2 with message counter for message1						     	
		if k>128 Then k=0 End If
    	msg2.Write PcanConn, timestamp				'//Transmitting data into CAN bus at Cycletime= 80 ms
    	counter2=0
    End If    
    
    counter3=counter3+1
    If(counter3=5)Then
		l=l+1
		msg3.Data(3) = l							'//Initializing the byte 3 with message counter for message1						     	
		if l>64 Then l=0 End If    
    	msg3.Write PcanConn, timestamp				'//Transmitting data into CAN bus at Cycletime= 100 ms
    	counter3=0
    End If    
    
    ' lowest timer intervall is 20ms - so we need a 20ms resolution
    Wait 20
    
 	
  	Loop While(loopcounter<1000) ' run forever?...no...until 1000 loops 
  
  
  ' Wait until all messages have been sent before finishing macro,
  '  since this would terminate the client and delete all messages
  '  that are still in the queue
  While not MyClient.XmtQueueEmpty
    Wait 500
  Wend
  Wait 500

  End Sub