VBAとレーザー変位計で立体物を測って図にしてみる [雑記]

#1,目的
レーザー変位形を用いて立体物の形を測って図にする
今回は高さを取得した後、図にするVBAのマクロを考えた
#2,環境
小さな工場で使用する用途を考えてみた
レーザー変位形が左右前後して高さを周期的に計測しPCが集計する
メカ部の機構はボールねじを用いてセンサーを移動する

また、メカ部の制御は三菱電機のPLC、MELSECに制御させるがここについては省略
##2-1,PLCの接点の動き
接点M102を開始のトリガー、M103を計測Readyに設定
計測ソフトが準備できたらM103をON、PLCサイドにスタートボタンをつけ、押されると動作開始とM102がONになり、PC側が接点を確認し集計スタート

##2-2,センサー値の取得について
レーザー変位形から出る高さのデータはアナログ値なのでPLC用のADコンバータを搭載し、D100のレジスタに周期的に代入する
2-1で書いたとおり、M102がONになった後D100レジスタをPC側が読みにいき表にまとめる

##2-3,機器の接続
PLCとPCはEthernetで接続されている
そのため、MELSECのライブラリActUtlTypeLibを用いる
なので、もしコピペして使いたい場合は変数「D100」の動きを良く見てほしい
RS232Cでマイコンからデータ拾う場合などD100に代入してM102,M103のトリガーを書き換えて行ってほしい
##2-4,集計方法
AD値が入ったD100変数をX方向Y方向の位置情報x_data,y_dataのsheet1のセルの場所に書き込んでいく
ただし(R1,C1)と(R1,C2)には測定したものの平面の大きさを記録するためx方向(colmmun)に1個ずつずれて記録されつ
ADの値は、0～4095の範囲で記録され4095は今回使用するセンサーでは範囲外を示すアナログ値のためすべて0に変更する
図の描画はsheet2のセルの背景をモノクロの濃淡で表現する

#3,ソースコード

Dim stopper As Boolean
Dim wdt_ms As Integer, x_data As Integer, y_data As Integer, M102 As Integer
'wdt_ms:計測サイクル、flonttimeの閾値
'x_data:X方向に何個目の測点
'y_data:Y方向に何個目の測点、通常M102がOFFのときx_dataを0にしインクリメントする(stop_actionプロシージャ参照)

'PC-PLC接続と初期化
Private Sub CommandButton1_Click()
    Dim name As String, value As Long
        ActUtlType1.ActLogicalStationNumber = 1
        If ActUtlType1.Open() = 0 Then
            ret = ActUtlType1.GetCpuType(name, value)
            If ret = 0 Then
                Label1.Caption = " CPU:" + name + vbCrLf + "TYPE:" + Str(value)
                ret = ActUtlType1.SetDevice2("M101", 1) = 1
                
            Else
                Label1.Caption = "ERR"
            End If
        Else
            ret = ActUtlType1.GetCpuType(name, value)
            If ret = 0 Then
                Label1.Caption = " CPU:" + name + vbCrLf + "TYPE:" + Str(value)
                ret = ActUtlType1.SetDevice2("M101", 1) = 1
                
            Else
                Label1.Caption = "Conection false"
            End If
            
        End If
    x_data = 0
    y_data = 0
End Sub

Private Sub CommandButton2_Click()
    stopper = False
    wdt_ms = 1 '閾値設定
       
    Dim fronttime As Integer, D100 As Integer 'flonttime：一定周期のパルスを作る変数
                                              '常にインクリメントしwdt_msの閾値に達するとリセットされる
                                              'D100:AD値が入る変数
    flonttime = 0 '初期化
    ret = ActUtlType1.SetDevice2("M103", 1) '計測Ready
    Do While True
        DoEvents: If stopper = True Then Exit Do 'ループ解除、集計終了
        
        If flonttime = wdt_ms Then
            ret = ActUtlType1.GetDevice2("D100", D100) 'PLCのD100レジスタから値を読みD100変数に代入
            ret = ActUtlType1.GetDevice2("M102", M102) 'M102の接点情報を見に行く
            Label2.Caption = Str(D100) 'AD値を表示する
            If M102 = 0 Then 'M102がオフの時
                stop_action '停止動作プロシージャを呼ぶ
            Else
                'M102がON、計測する
                x_data = x_data + 1 'X方向インクリメント
                '表書き込みアクション
                Sheet1.Cells(1 + y_data, 1 + x_data) = D100 '測定データを指定のセルに代入
            End If
        End If
        flonttime = flonttime + 1 'パルス用インクリメント
        'x_data y_data XとY方向の測点数の情報表示
        Label3.Caption = "X:" + Str(x_data)
        Label4.Caption = "Y:" + Str(y_data)
        'x_data y_data PLCに送信（なくても良い）
        ret = ActUtlType1.SetDevice2("D101", x_data)
        ret = ActUtlType1.SetDevice2("D102", y_data)
    Loop
End Sub

Private Sub CommandButton3_Click()
    'stopボタンが押された後の動作
    stopper = True 'ループ停止
    'M102,M103接点をオフにし、動作停止
    ret = ActUtlType1.SetDevice2("M103", 0)
    ret = ActUtlType1.SetDevice2("M102", 0)
    '停止動作
    stop_action
End Sub


Private Sub CommandButton4_Click()
    'RESETボタンの動作
    'sheet1,sheet2の描画クリア
    Sheet1.Cells.Clear
    Sheet2.Cells.Interior.Color = RGB(255, 255, 255)
    '位置情報のクリア
    x_data = 0
    y_data = 0
    'form上のクリア
    Label3.Caption = "X:" + Str(x_data)
    Label4.Caption = "Y:" + Str(y_data)
    'PC-PLCに変数代入(なくても良い)
    ret = ActUtlType1.SetDevice2("D101", x_data)
    ret = ActUtlType1.SetDevice2("D102", y_data)
End Sub

Private Sub CommandButton5_Click()
    '描画ボタン、Sheet2のセルの背景色を指定して図を描画する
    Dim x_copy As Integer, y_copy As Integer, x_buf As Integer, y_buf As Integer
    'x_copy y_copy:今回計測したデータの縦横の大きさ
    'x_buf y_buf:描画位置の変数、
    Dim color_value As Integer 'color_vaue:色情報 0～255の間
    
    '計測データの有無の確認
    If Sheet1.Cells(1, 1) = Null Or Sheet1.Cells(1, 1) = 0 Then
        'ないとき、メッセージボックス表示
        MsgBox "イメージ化するデータがありません"
    Else
        'あるとき
        'x_copy y_copyにsheet1の(1,1),(2,1)に記述されている描画の大きさデータを代入
        x_copy = Sheet1.Cells(1, 1)
        y_copy = Sheet1.Cells(2, 1)
        
        'x_copy y_copyの範囲のsheet1のデータを取得し色情報に変換
        For x_buf = 1 To x_copy
            For y_buf = 1 To y_copy
                If Sheet1.Cells(y_buf, x_buf + 1) = 4095 Then
                    'AD値4095はこのレーザー変位系の計測範囲外を示す値なので0を代入
                    color_value = 0
                Else
                    'AD値を255分割しその割合を0～255の範囲で代入
                    color_value = Int(Sheet1.Cells(y_buf, x_buf + 1) / (4095 / 255))
                    'sheet1と同じ位置にモノクロで背景色を指定
                    Sheet2.Cells(y_buf, x_buf).Interior.Color = RGB(color_value, color_value, color_value)
                End If
            Next y_buf
        Next x_buf
        
        'セルの幅と硬さをほぼ同じにする
        Sheet2.Range(Sheet2.Cells(1, 1), Sheet2.Cells(y_copy, 1)).RowHeight = 10
        Sheet2.Range(Sheet2.Cells(1, 1), Sheet2.Cells(1, x_copy)).ColumnWidth = 1
        
    End If
End Sub

Private Sub UserForm_Click()

End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    ret = ActUtlType1.SetDevice2("M101", 0)
    ret = ActUtlType1.Close()
End Sub

Sub stop_action()
    
    '動作停止
    '一回目の計測(y_data=0)のときのx方向の幅を(1,1)に代入
    If y_data = 0 Then Sheet1.Cells(1, 1) = x_data
    '二回目以降
    If x_data > 0 Then
        'Y方向インクリメント
        y_data = y_data + 1
        '二回目以降は(1,1)のデータより小さいときに代入する
        If x_data < Sheet1.Cells(1, 1) Then Sheet1.Cells(1, 1) = x_data
    End If
    'X方向、原点へ
    x_data = 0
    'Y方向、今何個目か
    Sheet1.Cells(2, 1) = y_data
    'XYの位置データ表示
    Label3.Caption = "X:" + Str(x_data)
    Label4.Caption = "Y:" + Str(y_data)
    'PC-PLCにx_data y_dataを送信(とくに必要ない)
    ret = ActUtlType1.SetDevice2("D101", x_data)
    ret = ActUtlType1.SetDevice2("D102", y_data)
End Sub

#4,結果
被測定物

測定・描画結果

#5,感想
はじめてQiitaに書いた