アルツの備忘録

最近、年のせいで物忘れが激しい。
そこで、いろんなことをここに記録して行きたいと思います。

LEGO MINDSTORMS の遠隔操作 3

2008年01月27日 23時00分21秒 | LEGO MINDSORMS
遠隔操作とセンサーによる動きが混じって動くもの作ろうかと考えています。
とりあえず、
NXTのバージョンやバッテリー残量を得る。
モータ制御の、パラメータを指定する。
センサーをセットして、情報を得る。

こんな、NXT制御盤を作ってみた。

ただ、センサーから返るデータが何を表しているか良く分からなく困っています、どこかに解説したところないですかね(日本語の・・・私は外国語も苦手です。)

--------------------------------------------------------
'<NXTからの応答を受け取る処理>
Private Sub MSComm1_OnComm()
'通信時に発生するイベントの処理
    
    Select Case MSComm1.CommEvent              ' CommEventプロパティに対する処理
        Case comEvReceive                      ' 受信データ有り
        	  '応答メッセージの編集処理
            Return_Mssge (MSComm1.Input)
            
        Case comEvSend                         ' 他の通信イベントでは何もしない
        Case comEvCTS
        Case comEvDSR
        Case comEvCDcal
        Case comEvRing
        Case comEvEOF
        Case CommEvent
        Case comEventBreak
            MsgBox "中断信号を受信", vbCritical '警告メッセージ アイコンを表示
        Case comEventCTSTO
            MsgBox "CTSタイムアウト", vbCritical
        Case comEventDSRTO
            MsgBox "DSRタイムアウト", vbCritical
        Case comEventFrame
            MsgBox "フレーム エラー", vbCritical
        Case comEventOverrun
            MsgBox "ポート オーバーラン", vbCritical
        Case comEventCDTO
            MsgBox "CDタイムアウト", vbCritical
        Case comEventRxOver
            MsgBox "受信バッファ オーバーフロー", vbCritical
        Case comEventRxParity
            MsgBox "パリティ エラー", vbCritical
        Case comEventTxFull
            MsgBox "送信バッファがいっぱい", vbCritical
        Case comEventDCB
            MsgBox "予期しないDCBエラー", vbCritical
        Case Else
            MsgBox "その他の通信エラー", vbCritical
    End Select
End Sub

'<応答メッセージの編集処理>
Private Sub Return_Mssge(msg)
'受信データ処理
    Dim Buf() As Byte                        ' 受信バッファの変数宣言
    Dim RDat        As Variant
    Dim St          As String
    Dim St1         As String
    Dim St2         As String
    Buf = msg
    St = ""
    For Each RDat In Buf
        St = St & Right$("00" & Hex$(RDat), 2) & " "
    Next
    
    '生データ表示
    Text2.Text = St & vbCrLf & Text2.Text
    
    If Right$("00" & Hex$(Buf(2)), 2) <> "02" Or Right$("00" & Hex$(Buf(4)), 2) <> "00" Then
       Exit Sub
    End If
    'データ表示編集
    Select Case Right$("00" & Hex$(Buf(3)), 2)
        Case "0B"
            'BatteryLevel
            Label11.Caption = CInt("&H" & Right$("00" & Hex$(Buf(6)), 2) & Right$("00" & Hex$(Buf(5)), 2))
        Case "88"
            'Firmware Version
            St1 = CInt("&H" & Right$("00" & Hex$(Buf(8)), 2))
            St2 = CInt("&H" & Right$("00" & Hex$(Buf(7)), 2))
            Label10.Caption = St1 & "." & St2
            
            'Protocol Version
            St1 = CInt("&H" & Right$("00" & Hex$(Buf(6)), 2))
            St2 = CInt("&H" & Right$("00" & Hex$(Buf(5)), 2))
            Label8.Caption = St1 & "." & St2
       'Case "07"
        '    'sensor
        '    Label11.Caption = CInt("&H" & Right$("00" & Hex$(Buf(6)), 2) & Right$("00" & Hex$(Buf(5)), 2))
        Case Else
        '    MsgBox "受信処理未定義"
    End Select
    
End Sub

--------------------------------------------------
<ダイレクトコマンド・システムコマンド>

Private Sub getFirmwareVersion()
    'NXTのファームウエアバージョン確認
    
    If Form1.MSComm1.PortOpen = False Then         ' シリアルポートのオープン
        Form1.MSComm1.PortOpen = True
    End If

    ReDim Buffer(3) As Byte

'セット内容
    Buffer(0) = &H2     '0x02 ; データbyte数 2
    Buffer(1) = &H0     '0x00 ; データbyte数  0
    Buffer(2) = &H1     '0x01 : system command 返信あり
    Buffer(3) = &H88    '0x88 ; get Firmware Version
    
    'データ送信
    Form1.MSComm1.Output = Buffer
    
    '送信データ出力
    Send_Mssge "Version:", Buffer
    
End Sub

Private Sub Command8_Click()
'電池残量
    
    If Form1.MSComm1.PortOpen = False Then         ' シリアルポートのオープン
        Form1.MSComm1.PortOpen = True
    End If

    ReDim Buffer(3) As Byte

'セット内容
    Buffer(0) = &H2     '0x02 ; データbyte数 2
    Buffer(1) = &H0     '0x00 ; データbyte数  0
    Buffer(2) = &H0     '0x00 : direct command 返信あり
    Buffer(3) = &HB     '0x88 ; get BatteryLevel
    
    'データ送信
    Form1.MSComm1.Output = Buffer
    
    '送信データ出力
    Send_Mssge "電池残量", Buffer
    
End Sub

Private Sub Command4_Click()
'SetOutputState データ送信
    '閉じていたらシリアルポートのオープン
    If MSComm1.PortOpen = False Then
        MSComm1.PortOpen = True
    End If
    
    '送信データの再定義
    ReDim Buffer(13) As Byte
    
    'フォームのデータを変数にセット
    For i = 0 To 13
        If i = 5 Or i = 8 Then
            'マイナスデータの為の処理
            Dim x As Integer
            Dim b As Byte
            x = CInt(Combo1(i))
            b = x And &HFF
            Buffer(i) = b
        Else
            Buffer(i) = "&H" & Combo1(i)
        End If
    Next
    'データ送信
    MSComm1.Output = Buffer
    
    '送信データ出力
    Send_Mssge "モータ制御:", Buffer
End Sub

Private Sub Command7_Click()
'音声ファイルを実行 good job

    '閉じていたらシリアルポートのオープン
    If MSComm1.PortOpen = False Then
        MSComm1.PortOpen = True
    End If
    
    ReDim Buffer(17) As Byte
    'Good Job.rsoのサウンドファイルを実行させる命令
    
    Buffer(0) = &H10   '送信バイト 18 - 2 バイト
    Buffer(1) = &H0    '送信バイト
    Buffer(2) = &H80   'Command Type  0x80:ダイレクトコマンド応答不要
    Buffer(3) = &H2    'SET OUTPUT STATE 0x02:PLAYSOUNDFILE(サウンドファイルを再生)
    Buffer(4) = &H0    '再生を繰り返す場合は 1、繰り返さない場合は 0
    Buffer(5) = &H47   'これ以降ファイル名 Good Job.rso +¥0
    Buffer(6) = &H6F
    Buffer(7) = &H6F
    Buffer(8) = &H64
    Buffer(9) = &H20
    Buffer(10) = &H4A
    Buffer(11) = &H6F
    Buffer(12) = &H62
    Buffer(13) = &H2E
    Buffer(14) = &H72
    Buffer(15) = &H73
    Buffer(16) = &H6F
    Buffer(17) = &H0
     
    'データ送信
    MSComm1.Output = Buffer
    '送信データ出力
    Send_Mssge "good job:", Buffer

End Sub

Private Sub Command1_Click()
'ビープ音
    If MSComm1.PortOpen = False Then       ' シリアルポートのオープン
        MSComm1.PortOpen = True
    End If
    '4,5 200-14000HZ  6,7 MS
    ReDim Buffer(7) As Byte
    Buffer(0) = &H6
    Buffer(1) = &H0
    Buffer(2) = &H80
    Buffer(3) = &H3
    Buffer(4) = "&H" & Text3.Text
    Buffer(5) = "&H" & Text4.Text
    Buffer(6) = "&H" & Text5.Text
    Buffer(7) = "&H" & Text6.Text
     
    MSComm1.Output = Buffer
     
    '送信データ出力
    Send_Mssge "PlayTone:", Buffer

End Sub

Private Sub Command2_Click()
'モータ駆動
    If MSComm1.PortOpen = False Then         ' シリアルポートのオープン
        MSComm1.PortOpen = True
    End If

    ReDim Buffer(13) As Byte

'セット内容
' 0xC,    /0 送信バイト 14 - 2 バイト
' 0x00,  /1 送信バイト
' 0x00,   /2 Command Type 0x00 0x80 ダイレクトコマンド
' 0x04,   /3 SET OUTPUT STATE */
' 0xFF    /4 Output Port(0- 2, 0xFF:ALL) */
' 0,      /5 Power set point (-100 - 100) */
' 1+2,    /6 Mode byte (1=Moter on / 2=Breake(ブレーキ)/ 4=Requlated) 組合せ指定*/
' 0,      /7 Requlation mode (0=no Requlation / 1=Control speed / 2=Moter sync) Requlated指定の場合のオプション*/
' 0,      /8 Turn ratio  (-100 - 100) Moter syncの時のオプション*/
' 0x20,   /9 Run state(0x00=Idle / 0x10=Ramp up / 0x20=Running / 0x30=Ramp down) */
' 0,0,0,0 /10-13 Tacho Limit 回転の目標角度*/

    Buffer(0) = &HC
    Buffer(1) = &H0
    Buffer(2) = &H80
    Buffer(3) = &H4
    Buffer(4) = &HFF
    Buffer(5) = &H20
    Buffer(6) = &H3
    Buffer(7) = &H0
    Buffer(8) = &H0
    Buffer(9) = &H20
    Buffer(10) = &H0
    Buffer(11) = &H0
    Buffer(12) = &H0
    Buffer(13) = &H0
    
'データ送信
    MSComm1.Output = Buffer
'送信データ出力
    Send_Mssge "前進:", Buffer
End Sub

Private Sub Command3_Click()
'モータ停止
    If MSComm1.PortOpen = False Then        ' シリアルポートのオープン
        MSComm1.PortOpen = True
    End If

    ReDim Buffer(13) As Byte
Dim a As Double

'セット内容
    Buffer(0) = &HC
    Buffer(1) = &H0
    Buffer(2) = &H80
    Buffer(3) = &H4
    Buffer(4) = &HFF
    Buffer(5) = &H0 'パワー 0 指定
    Buffer(6) = &H3
    Buffer(7) = &H0
    Buffer(8) = &H0
    Buffer(9) = &H20
    Buffer(10) = &H0
    Buffer(11) = &H0
    Buffer(12) = &H0
    Buffer(13) = &H0
    
    'データ送信
    MSComm1.Output = Buffer
    '送信データ出力
    Send_Mssge "停止:", Buffer

End Sub

Private Sub Send_Mssge(kbn, msg)
'処理データ表示処理
    Dim Buf() As Byte
    Dim RDat        As Variant
    Dim St          As String
    Buf = msg
    St = kbn
    For Each RDat In Buf
        St = St & Right$("00" & Hex$(RDat), 2) & " "
    Next
    
    Text1.Text = St & vbCrLf & Text1.Text
        
End Sub


---------------------------------------------------------------


最新の画像もっと見る

コメントを投稿