| |
こんばんは。maさんもう見ていないかな？
私はmaさんと同じ機械加工業をしている物です。（いつもは質問者です。）
maさんが提示されたデータはJISで規定されている、工作機械を動かす為の
Gコードと呼ばれるNCプログラムです。（みなさんがいま触っているマウスも
こういうデータによって、金属を機械で削り出してオス、メスの金型がつくら
れ出来ています。）私もNCプログラムをあれこれいじるプログラムをVBAでよ
く作るので、興味があって作ってみました。
maさんのやりたかった事が 次工具を呼ぶのをやめて、工具交換⇒工具長⇒
加工⇒工具交換⇒工具長⇒加工⇒終了 だったとすると（私が見た限りでは
こう解釈しましたが....違いました？）
標準モジュールにこれをコピーして下さい。実行するとファイル選択の
ダイアログがでてくるので、変換するプログラムを選択して下さい。
（選択したファイルを書き換えてしまう為、念のためファイルコピー
をしておいた方がいいです）
Sub NC_PRO_CHANGE()
Dim FlName As String
Dim i As Integer
Dim myTxt As String
Dim MyPRO() As String
Dim LineCount As Long
Dim M06Fg As Integer, HitFg As Integer
Dim myHNo As Integer, myTNo As Integer
Dim M06Count As Integer
Dim l As Long
Dim p As Integer, findH As Integer, pp As Integer
Dim hanteiMOJI(1 To 13) As String
hanteiMOJI(1) = "0"
hanteiMOJI(2) = "1"
hanteiMOJI(3) = "2"
hanteiMOJI(4) = "3"
hanteiMOJI(5) = "4"
hanteiMOJI(6) = "5"
hanteiMOJI(7) = "6"
hanteiMOJI(8) = "7"
hanteiMOJI(9) = "8"
hanteiMOJI(10) = "9"
hanteiMOJI(11) = "-"
hanteiMOJI(12) = "."
hanteiMOJI(13) = " "
On Error GoTo ERR_TRAP:
i = FreeFile
FlName = Application.GetOpenFilename()
If FlName = "False" Then Exit Sub
M06Count = 0
LineCount = 0
M06Fg = 0
myHNo = 0
myTNo = 0
Open FlName For Input As #i
Do Until EOF(i)
Line Input #i, myTxt
LineCount = LineCount + 1
ReDim Preserve MyPRO(1 To 1, 1 To LineCount) As String
MyPRO(1, LineCount) = myTxt
Loop
Close #i
For l = 1 To UBound(MyPRO, 2)
If Left(MyPRO(1, l), 3) = "M06" Then
M06Fg = 1: m06row = l: M06Count = M06Count + 1
End If
If Left(MyPRO(1, l), 1) = "O" Or Left(MyPRO(1, l), 1) = "$" Or Left(MyPRO(1, l), 1) = "(" Then
Else
If InStr(1, MyPRO(1, l), "H") > 0 And M06Fg = 1 Then
findH = InStr(1, MyPRO(1, l), "H")
For pp = findH + 1 To Len(MyPRO(1, l))
For p = 1 To 13
HitFg = 0
If Mid(MyPRO(1, l), pp, 1) = hanteiMOJI(p) Or pp = Len(MyPRO(1, l)) Then
HitFg = 1
If pp = Len(MyPRO(1, l)) Then pp = pp + 1: HitFg = 0
Exit For
End If
Next
If HitFg = 0 Then
myHNo = Mid(MyPRO(1, l), findH + 1, pp - (findH + 1))
Exit For
End If
Next
End If
If InStr(1, MyPRO(1, l), "T") > 0 And M06Count >= 1 Then
findH = InStr(1, MyPRO(1, l), "T")
HitFg = 0
For pp = findH + 1 To Len(MyPRO(1, l))
For p = 1 To 13
HitFg = 0
If Mid(MyPRO(1, l), pp, 1) = hanteiMOJI(p) Or pp = Len(MyPRO(1, l)) Then
HitFg = 1
If pp = Len(MyPRO(1, l)) Then pp = pp + 1: HitFg = 0
Exit For
End If
Next
If HitFg = 0 Then
myTNo = Mid(MyPRO(1, l), findH + 1, pp - (findH + 1))
myTrow = l
MyPRO(1, l) = WorksheetFunction.Replace(MyPRO(1, l), findH, Len(myTNo) + 1, "")
Exit For
End If
Next
End If
If M06Count = 1 Then
M06Fg = 0: myHNo = 0: myTNo = 0
Else
If M06Fg = 1 And myHNo <> 0 Then
MyPRO(1, m06row) = "G49M06T" & myHNo
M06Fg = 0: myHNo = 0
End If
End If
End If
Next
Open FlName For Output As #i
For pp = 1 To UBound(MyPRO, 2)
Print #i, MyPRO(1, pp)
Next
Close #i
MsgBox "変換が終了しました。"
Exit SUb
ERR_TRAP:
End Sub
maさんはプログラムの先頭を省略していましたが、私の推測で最初の
工具交換指令までなくなっては困ると思い一回目のT**はそのまま残る
用にしてあります。なのでここに提示されているデータでは変換はされ
ません。（対応しているのは工具交換指令が2回以上あるデータに対して
有効です。） これも推測ですが、機械の対話もしくはCAD-CAM
でプログラムを作成されているなら関係ありませんが、手打ちで作っ
ている場合、M06をM6とした場合は変換されませんのでご注意を。
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
