📄 main.frm
字号:
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H00C0C0FF&
ForeColor = &H00000000&
Height = 285
Index = 2
Left = 1035
Locked = -1 'True
TabIndex = 9
TabStop = 0 'False
Text = "N/A"
Top = 1170
Width = 1185
End
Begin VB.TextBox txtD
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H00C0FFC0&
Height = 285
Index = 2
Left = 2430
TabIndex = 8
Text = "75"
Top = 1170
Width = 1185
End
Begin VB.TextBox txtC
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H00C0C0FF&
ForeColor = &H00000000&
Height = 285
Index = 1
Left = 1035
Locked = -1 'True
TabIndex = 7
TabStop = 0 'False
Text = "N/A"
Top = 810
Width = 1185
End
Begin VB.TextBox txtD
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H00C0FFC0&
Height = 285
Index = 1
Left = 2430
TabIndex = 6
Text = "20"
Top = 810
Width = 1185
End
Begin VB.TextBox txtD
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H00C0FFC0&
Height = 285
Index = 0
Left = 2430
TabIndex = 5
Text = "60"
Top = 450
Width = 1185
End
Begin VB.TextBox txtC
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H00C0C0FF&
ForeColor = &H00000000&
Height = 285
Index = 0
Left = 1035
Locked = -1 'True
TabIndex = 4
TabStop = 0 'False
Text = "N/A"
Top = 450
Width = 1185
End
Begin VB.Label Label20
AutoSize = -1 'True
Caption = "目标值："
Height = 195
Left = 2745
TabIndex = 23
Top = 180
Width = 720
End
Begin VB.Label Label19
AutoSize = -1 'True
Caption = "当前值："
Height = 195
Left = 1350
TabIndex = 22
Top = 180
Width = 720
End
Begin VB.Label Label18
AutoSize = -1 'True
Caption = "腕关节扭："
Height = 195
Left = 90
TabIndex = 21
Top = 2295
Width = 900
End
Begin VB.Label Label17
AutoSize = -1 'True
Caption = "腰关节："
Height = 195
Left = 90
TabIndex = 20
Top = 855
Width = 720
End
Begin VB.Label Label16
AutoSize = -1 'True
Caption = "肩关节："
Height = 195
Left = 90
TabIndex = 19
Top = 1215
Width = 720
End
Begin VB.Label Label15
AutoSize = -1 'True
Caption = "肘关节："
Height = 195
Left = 90
TabIndex = 18
Top = 1575
Width = 720
End
Begin VB.Label Label14
AutoSize = -1 'True
Caption = "腕关节转："
Height = 195
Left = 90
TabIndex = 17
Top = 1935
Width = 900
End
Begin VB.Label Label13
AutoSize = -1 'True
Caption = "移动副："
Height = 195
Left = 90
TabIndex = 16
Top = 495
Width = 720
End
End
Begin VB.CommandButton cmdExit
Caption = "退出"
Height = 420
Left = 3960
TabIndex = 2
Top = 3915
Width = 1095
End
Begin VB.CommandButton cmdMove
Caption = "运动"
Height = 420
Left = 3960
TabIndex = 1
Top = 630
Width = 1095
End
Begin VB.CommandButton cmdInit
Caption = "初始位置"
Height = 420
Left = 3960
TabIndex = 0
Top = 90
Width = 1095
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "速度："
Height = 195
Left = 3960
TabIndex = 42
Top = 1170
Width = 540
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim dSpeed As Double
Private Sub chkMultPos_Click()
frmMultPos.Enabled = chkMultPos.Value
If frmMultPos.Enabled Then
iCurPos = 0
LoadPreSetData
End If
End Sub
Private Sub cmdEditMultPoint_Click()
Me.Hide
frmPointEdit.Show
End Sub
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub cmdInit_Click()
Dim val(5)
Dim i As Long
T1.Enabled = False
cmdMove.Caption = "运动"
For i = 0 To 5
val(i) = 0
txtC(i).Text = 0
txtD(i).Text = 0
Next
ArmMech.PutCommandValues val
GetResult
iCurPos = 0
End Sub
Private Sub cmdMove_Click()
T1.Enabled = Not T1.Enabled
If T1.Enabled Then
cmdMove.Caption = "停止"
Else
cmdMove.Caption = "运动"
End If
End Sub
Private Sub Form_Load()
MakeMeOnTop Me.hwnd
Me.Move Screen.Width - Me.Width - 1000, Screen.Height - Me.Height - 1500
Me.Show
ReDim iPosArr(1 To 6, 0 To 1)
iCurPos = 0
InitCATIA
Dim dVal(5)
Dim i As Long
ArmMech.GetCommandValues dVal
GetResult
For i = 0 To 5
txtC(i).Text = dVal(i)
Next
dSpeed = val(txtSpeed)
frmWait.Visible = False
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Unload frmPointEdit
End Sub
Private Sub T1_Timer()
Static dVal(5) 'As Double
Dim i As Long
ArmMech.GetCommandValues dVal
For i = 0 To 5
If Abs(dVal(i) - val(txtD(i).Text)) < dSpeed Then
dVal(i) = val(txtD(i).Text)
Else
dVal(i) = dVal(i) + dSpeed * Sgn(val(txtD(i).Text) - dVal(i))
End If
txtC(i).Text = dVal(i)
Next
ArmMech.PutCommandValues dVal
GetResult
If chkSavePic.Value = 1 Then
Static iStep As Long
iStep = iStep + 1
Dim fn As String
fn = App.Path & "\cap-" & Format$(iStep, "0000") & ".tif"
Dim oView As Viewer3D
Set oView = CATIA.ActiveWindow.ActiveViewer
oView.CaptureToFile catCaptureFormatTIFF, fn
End If
Dim StopFlag As Boolean
StopFlag = True
For i = 0 To 5
If Not txtC(i).Text = txtD(i).Text Then
StopFlag = False
Exit For
End If
Next
If StopFlag Then
If chkMultPos.Value = 1 Then
If Not LoadPreSetData Then
T1.Enabled = False
cmdMove.Caption = "运动"
End If
If chkPauseAtPos.Value = 1 Then
T1.Enabled = False
cmdMove.Caption = "运动"
End If
Else
T1.Enabled = False
cmdMove.Caption = "运动"
End If
End If
End Sub
Private Sub txtSpeed_Change()
dSpeed = Abs(val(txtSpeed))
End Sub
Function LoadPreSetData() As Boolean
Dim i As Long
iCurPos = iCurPos + 1
If iCurPos > iPosCount Then
If chkAutoLoop.Value = 1 Then
iCurPos = 1
Else
LoadPreSetData = False
Exit Function
End If
End If
For i = 1 To 6
txtD(i - 1).Text = iPosArr(i, iCurPos)
Next
LoadPreSetData = True
End Function
Sub GetResult()
Dim obj(11)
' 系统坐标系与D-H坐标不一致时可在此调整
' 当前系统坐标与D-H坐标对应关系为：
' x --- Z
' y --- X
' z --- Y
' n
Set obj(0) = cTheMeasure.Item("Arm_for_sim\DirN\Diry")
Set obj(1) = cTheMeasure.Item("Arm_for_sim\DirN\Dirz")
Set obj(2) = cTheMeasure.Item("Arm_for_sim\DirN\Dirx")
' o
Set obj(3) = cTheMeasure.Item("Arm_for_sim\DirO\Diry")
Set obj(4) = cTheMeasure.Item("Arm_for_sim\DirO\Dirz")
Set obj(5) = cTheMeasure.Item("Arm_for_sim\DirO\Dirx")
' a
Set obj(6) = cTheMeasure.Item("Arm_for_sim\DirA\Diry")
Set obj(7) = cTheMeasure.Item("Arm_for_sim\DirA\Dirz")
Set obj(8) = cTheMeasure.Item("Arm_for_sim\DirA\Dirx")
' p
Set obj(9) = cTheMeasure.Item("Arm_for_sim\Pos\Gy")
Set obj(10) = cTheMeasure.Item("Arm_for_sim\Pos\Gz")
Set obj(11) = cTheMeasure.Item("Arm_for_sim\Pos\Gx")
Dim i As Long
For i = 0 To 8
txtResult(i).Text = Format(obj(i).Value, "###0. 0000")
Next
For i = 9 To 11
txtResult(i).Text = Format(obj(i).Value, "###0.000")
Next
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -