回复 2楼 renxiaoyao36
Option Explicit
Public CurrentNX As Single, CurrentNY As Single, CurrentNZ As Single, CurrentNF As Single, CurrentNR As Single, CurrentNI As Single, CurrentNJ As Single, PauseRun As Boolean, TempX As Single, TempY As Single, TempZ As Single
Public VIEWXYZ As Boolean, OPX As Single, OPY As Single, OPZ As Single, FalsePoint As Boolean, MirrorX As Boolean, MirrorY As Boolean, CurrentGM As String
Dim RunFast As Integer, FirstPoint As Boolean, NOTX As Boolean, NOTIJ As Boolean, NEWZ As Single
Public StopRun As Boolean, SCALESIZE As Single, HowDC As Boolean, UserRTODC As Boolean, LineW As Integer
Sub G00(X As Single, Y As Single, Z As Single)
'G00过程
frmmain.lblState.Caption = "快速定位到" & "X:" & X & " Y:" & Y & " Z:" & Z
CurrentNX = X
'定位到当前坐标
CurrentNY = Y
CurrentNZ = Z
End Sub
Sub G01(X As Single, Y As Single, Z As Single)
'G01过程
Dim X1 As Single, Y1 As Single, SPointX As Single, SPointY As Single, I As Single, L As Single
On Error GoTo errhand
If X = CurrentNX And Y = CurrentNY And Z = CurrentNZ Then
Exit Sub
End If
If StopRun = True Then
Exit Sub
End If
frmmain.lblState.Caption = "直线插补|" & "起点: X" & CurrentNX & " Y" & CurrentNY & " Z" & CurrentNZ & "终点: X" & X & " Y" & Y & " Z" & Z
SPointX = CurrentNX
SPointY = CurrentNY
If X <> CurrentNX Then
Dim K As Single
K = (Y - CurrentNY) / (X - CurrentNX)
For I = CurrentNX To X Step Sgn(X - CurrentNX)
Y1 = SPointY + K * (I - SPointX)
X1 = I
Call DrawLine(CurrentNX, CurrentNY, X1, Y1)
CurrentNX = X1
CurrentNY = Y1
CurrentNZ = Z
Next I
Else
For I = CurrentNY To Y Step Sgn(Y - CurrentNY)
Y1 = I
X1 = CurrentNX
Call DrawLine(CurrentNX, CurrentNY, X1, Y1)
CurrentNX = X1
CurrentNY = Y1
CurrentNZ = Z
If X = CurrentNX And Y = CurrentNY And Z = CurrentNZ Then
Exit Sub
End If
Next I
End If
Exit Sub
errhand:
If StopRun = False Then
MsgBox "程序发生错误,请检查G代码!", vbOKOnly, "错误"
End If
End Sub
Public Sub TXTTOGRAPHIC(CODETXT As String)
'G代码分析过程
Dim I As Single, J As Single, X1 As Single, Y1 As Single, Z1 As Single, R1 As Single, I2 As Single, J2 As Single, D2 As Single, F1 As Integer
Dim TempTxt As String, TempCode() As String, HX1 As Boolean, HY1 As Boolean, HZ1 As Boolean, HR1 As Boolean, HI2 As Boolean, HJ2 As Boolean, HD2 As Boolean, HF1 As Boolean
Dim CodeNUM As String, TempZ As Single, TempI As Single, TempJ As Single, GMTRUE As Boolean, TempX1 As Single, TempX2 As Single, TempY1 As Single, TempY2 As Single
On Error GoTo errhand
If StopRun = True Then
Exit Sub
End If
I = 0
GMTRUE = False
NOTIJ = False
NOTX = False
UserRTODC = False
For J = Len(CODETXT) To 1 Step -1
'分离X\Y\Z\G\M等到数组,如G00X10Y10 分离后为 G00、X10、Y10
If IsNumeric(Mid$(CODETXT, J, 1)) Or Mid$(CODETXT, J, 1) = "-" Or Mid$(CODETXT, J, 1) = "." Or Mid$(CODETXT, J, 1) = " " Then
If Mid$(CODETXT, J, 1) <> " " Then
TempTxt = Mid$(CODETXT, J, 1) & TempTxt
End If
Else
ReDim Preserve TempCode(I)
TempCode(I) = Mid$(CODETXT, J, 1) & TempTxt
TempTxt = ""
I = I + 1
End If
Next J
NOTX = True
For J = 0 To UBound(TempCode)
'把XYZIJR等的值存到变量,并用标记
TempTxt = Left$(TempCode(J), 1)
Select Case TempTxt
Case "X"
X1 = Val(Mid$(TempCode(J), 2))
NOTX = False
HX1 = True
Case "Y"
Y1 = Val(Mid$(TempCode(J), 2))
HY1 = True
NOTX = False
Case "Z"
Z1 = Val(Mid$(TempCode(J), 2))
NEWZ = Z1
HZ1 = True
NOTX = False
Case "I"
I2 = Val(Mid$(TempCode(J), 2))
HI2 = True
Case "J"
J2 = Val(Mid$(TempCode(J), 2))
HJ2 = True
Case "R"
R1 = Val(Mid$(TempCode(J), 2))
HR1 = True
UserRTODC = True
Case "D"
D2 = Val(Mid$(TempCode(J), 2))
HD2 = True
Case "F"
F1 = Val(Mid$(TempCode(J), 2))
frmmain.LblV.Caption = F1
CurrentNF = F1
HF1 = True
Case "N"
Case Else
End Select
Next J
If HI2 = False And HJ2 = False Then
NOTIJ = True
End If
If HR1 = True Then
NOTIJ = False
End If
If HX1 = False Then
'当G代码中没有X,则用当前点X代替,Y,Z也一样
If FalsePoint = False Then
If MirrorY = True Then
X1 = -CurrentNX
Else
X1 = CurrentNX
End If
Else
X1 = 0
End If
End If
If HY1 = False Then
If FalsePoint = False Then
If MirrorX = True Then
Y1 = -CurrentNY
Else
Y1 = CurrentNY
End If
Else
Y1 = 0
End If
End If
If HZ1 = False Then
If FalsePoint = False Then
Z1 = CurrentNZ
NEWZ = Z1
Else
Z1 = 0
NEWZ = Z1
End If
End If
If HI2 = False Then
'没有输入IJ,则用零代替
I2 = 0
End If
If HJ2 = False Then
J2 = 0
End If
If HF1 = True Then
frmmain.LblV.Caption = F1
End If
If HD2 = True Then
If D2 = 1 Then
frmmain.lblST.Caption = frmmain.TXTST(0).Text
Else
frmmain.lblST.Caption = frmmain.TXTST(1).Text
End If
End If
For J = 0 To UBound(TempCode)
'先处理M代码
TempTxt = Left$(TempCode(J), 1)
Select Case TempTxt
Case "M"
CodeNUM = Trim$(Mid$(TempCode(J), 2))
Select Case CodeNUM
Case "02"
Call M02
Case "03"
Call M03
Case "04"
Call M04
Case "05"
Call M05
Case "08"
Call M08
Case "09"
Call M09
Case "02"
Call M2
Case "03"
Call M3
Case "04"
Call M4
Case "05"
Call M5
Case "08"
Call M8
Case "09"
Call M9
Case "21"
Call M21
Case "22"
Call M22
Case "23"
Call M23
Case "30"
Call M30
End Select
End Select
Next J
For J = 0 To UBound(TempCode)
'先处理G54\G92\G90\G91
TempTxt = Trim$(TempCode(J))
If TempTxt = "G54" Then
Call G54
End If
Next J
For J = 0 To UBound(TempCode)
TempTxt = Trim$(TempCode(J))
If TempTxt = "G92" Then
Call G92(X1, Y1, Z1)
End If
Next J
For J = 0 To UBound(TempCode)
TempTxt = Trim$(TempCode(J))
If TempTxt = "G90" Then
Call G90
End If
Next J
For J = 0 To UBound(TempCode)
TempTxt = Trim$(TempCode(J))
If TempTxt = "G91" Then
Call G91
End If
Next J
For J = 0 To UBound(TempCode)
'处理G00,G01,G02,G03
TempTxt = Left$(TempCode(J), 1)
Select Case TempTxt
Case "G"
CodeNUM = Trim$(Mid$(TempCode(J), 2))
Select Case CodeNUM
Case "00"
Call ABSPoint(X1, Y1, Z1)
Call G00(X1, Y1, Z1)
GMTRUE = True
'保留功能
CurrentGM = "G00"
Case "0"
Call ABSPoint(X1, Y1, Z1)
Call G00(X1, Y1, Z1)
GMTRUE = True
'保留功能
CurrentGM = "G00"
Case "01"
Call ABSPoint(X1, Y1, Z1)
Call G01(X1, Y1, Z1)
GMTRUE = True
CurrentGM = "G01"
Case "1"
Call ABSPoint(X1, Y1, Z1)
Call G01(X1, Y1, Z1)
GMTRUE = True
CurrentGM = "G01"
Case "02"
If HR1 = True Then
Call GetCenterPoint(X1, Y1, R1, True, I2, J2)
'根据R计算圆心位置
I2 = I2
J2 = J2
End If
Call ABSPoint(X1, Y1, Z1)
If MirrorY = True Or MirrorX = True Then
Call ABSPoint(I2, J2, TempZ)
'转换到绝对坐标
End If
If HR1 = True Then
CurrentNR = Abs(R1)
Else
CurrentNR = (I2 ^ 2 + J2 ^ 2) ^ 0.5
End If
I2 = I2 + CurrentNX
J2 = J2 + CurrentNY
If (MirrorY Xor MirrorX) = True Then
Call G03(X1, Y1, I2, J2)
Else
Call G02(X1, Y1, I2, J2)
End If
GMTRUE = True
CurrentGM = "G02"
Case "2"
If HR1 = True Then
Call GetCenterPoint(X1, Y1, R1, True, I2, J2)
'根据R计算圆心位置
I2 = I2
J2 = J2
End If
Call ABSPoint(X1, Y1, Z1)
If MirrorY = True Or MirrorX = True Then
Call ABSPoint(I2, J2, TempZ)
'转换到绝对坐标
End If
If HR1 = True Then
CurrentNR = Abs(R1)
Else
CurrentNR = (I2 ^ 2 + J2 ^ 2) ^ 0.5
End If
I2 = I2 + CurrentNX
J2 = J2 + CurrentNY
If (MirrorY Xor MirrorX) = True Then
Call G03(X1, Y1, I2, J2)
Else
Call G02(X1, Y1, I2, J2)
End If
GMTRUE = True
CurrentGM = "G02"
Case "03"
If HR1 = True Then
Call GetCenterPoint(X1, Y1, R1, False, I2, J2)
End If
Call ABSPoint(X1, Y1, Z1)
If MirrorY = True Or MirrorX = True Then
Call ABSPoint(I2, J2, TempZ)
End If
If HR1 = True Then
CurrentNR = Abs(R1)
Else
CurrentNR = (I2 ^ 2 + J2 ^ 2) ^ 0.5
End If
I2 = I2 + CurrentNX
J2 = J2 + CurrentNY
If (MirrorY Xor MirrorX) = True Then
Call G02(X1, Y1, I2, J2)
Else
Call G03(X1, Y1, I2, J2)
End If
GMTRUE = True
CurrentGM = "G03"
Case "3"
If HR1 = True Then
Call GetCenterPoint(X1, Y1, R1, False, I2, J2)
End If
Call ABSPoint(X1, Y1, Z1)
If MirrorY = True Or MirrorX = True Then
Call ABSPoint(I2, J2, TempZ)
End If
If HR1 = True Then
CurrentNR = Abs(R1)
Else
CurrentNR = (I2 ^ 2 + J2 ^ 2) ^ 0.5
End If
I2 = I2 + CurrentNX
J2 = J2 + CurrentNY
If (MirrorY Xor MirrorX) = True Then
Call G02(X1, Y1, I2, J2)
Else
Call G03(X1, Y1, I2, J2)
End If
GMTRUE = True
CurrentGM = "G03"
Case "04"
Call G04
Case "28"
Call G28
Case "29"
Call G29
Case "40"
Call G40
Case "41"
Call G41
Case "42"
Call G42
End Select
End Select
Next J
If GMTRUE = False Then
'如果没输入G指令,则用保留功能中的G指令代替
Select Case CurrentGM
Case "G01"
If NOTX = False Then
Call ABSPoint(X1, Y1, Z1)
Call G01(X1, Y1, Z1)
GMTRUE = True
CurrentGM = "G01"
End If
Case "G02"
If NOTX = False And NOTIJ = False Then
If HR1 = True Then
Call GetCenterPoint(X1, Y1, R1, True, I2, J2)
End If
Call ABSPoint(X1, Y1, Z1)
If MirrorY = True Or MirrorX = True Then
Call ABSPoint(I2, J2, TempZ)
End If
If HR1 = True Then
CurrentNR = Abs(R1)
Else
CurrentNR = (I2 ^ 2 + J2 ^ 2) ^ 0.5
End If
I2 = I2 + CurrentNX
J2 = J2 + CurrentNY
If (MirrorX Xor MirrorY) = True Then
Call G03(X1, Y1, I2, J2)
Else
Call G02(X1, Y1, I2, J2)
End If
GMTRUE = True
CurrentGM = "G02"
End If
Case "G03"
If NOTX = False And NOTIJ = False Then
If HR1 = True Then
Call GetCenterPoint(X1, Y1, R1, False, I2, J2)
End If
Call ABSPoint(X1, Y1, Z1)
If MirrorY = True Or MirrorX = True Then
Call ABSPoint(I2, J2, TempZ)
End If
If HR1 = True Then
CurrentNR = Abs(R1)
Else
CurrentNR = (I2 ^ 2 + J2 ^ 2) ^ 0.5
End If
I2 = I2 + CurrentNX
J2 = J2 + CurrentNY
If (MirrorX Xor MirrorY) = True Then
Call G02(X1, Y1, I2, J2)
Else
Call G03(X1, Y1, I2, J2)
End If
GMTRUE = True
CurrentGM = "G03"
End If
End Select
End If
Exit Sub
errhand:
If StopRun = False Then
MsgBox "仿真过程发生错误,请检查G代码!", vbOKOnly, "错误"
End If
End Sub
我是个小白，谢谢大神指点了。这是个模拟画直线或圆弧的程序，我想知道其中用的函数是什么。
