Sub pcDMIS_replace_MOVE_INCREMENT() ' --- Error ------------------------------------------------------------------------------ On Error GoTo ErrorHandler ' --- Dim something ------------------------------------------------------------------------------ Dim vpcDMIS_App, vpcDMIS_Part, vpcDMIS_Cmds, vpcDMIS_Cmd, vpcDMIS_CmdIn As Object Set vpcDMIS_App = CreateObject("PCDLRN.Application") Set vpcDMIS_Part = vpcDMIS_App.ActivePartProgram Set vpcDMIS_Cmds = vpcDMIS_Part.Commands Set vpcDMIS_Cmd = Nothing Dim iHitIndex As Integer Dim sPuffer1, sPuffer2 As String Dim N1 As Integer Dim vN_HITS As String Dim retval Dim vMOVE_INCREMENT_THEO_X As Double Dim vMOVE_INCREMENT_THEO_Y As Double Dim vMOVE_INCREMENT_THEO_Z As Double Dim vLAST_HIT_X, vRETRACT_HIT_X, vDESTI_POINT_X As Double Dim vLAST_HIT_Y, vRETRACT_HIT_Y, vDESTI_POINT_Y As Double Dim vLAST_HIT_Z, vRETRACT_HIT_Z, vDESTI_POINT_Z As Double Dim vLAST_HIT_I As Double Dim vLAST_HIT_J As Double Dim vLAST_HIT_K As Double Dim bMOVE_CLEARP As Boolean Dim vRETRACT_DISTANCE, vPROBE_R As Double Dim vWORK_PLANE, vPROBE_ID, vPROBE_TIPID As String Dim vCPLANE_DISTANCE As Double Dim bAUTO_CLEAR_PLANE As Boolean Dim iLoopIndex, iChanged As Integer ' --- save part ------------------------------------------------------------------------------------ vpcDMIS_Part.Save ' --- search Commands ------------------------------------------------------------------------------ iLoopIndex = 0 iChanged = 0 For Each vpcDMIS_Cmd In vpcDMIS_Cmds ' *** user info ************** iLoopIndex = iLoopIndex + 1 vpcDMIS_App.StatusBar = "Script: Cycling through commands. Current command: " & iLoopIndex ' *** find Probe infos ************** If vpcDMIS_Cmd.Type = GET_PROBE_DATA Then vPROBE_ID = vpcDMIS_Cmd.GetText(FILE_NAME, 0) End If If vpcDMIS_Cmd.Type = SET_ACTIVE_TIP Then vPROBE_TIPID = vpcDMIS_Cmd.GetText(REF_ID, 0) vPROBE_R = vpcDMIS_Part.Probes.Item(vPROBE_ID).Tips.Item(vPROBE_TIPID).diam / 2 End If ' *** find RETRACT_DISTANCE infos ************** If vpcDMIS_Cmd.Type = RETRACT_DISTANCE Then vRETRACT_DISTANCE = vpcDMIS_Cmd.GetText(DISTANCE, 0) End If ' *** find CLEARANCE_PLANE infos ************** If vpcDMIS_Cmd.Type = CLEARANCE_PLANE Then vWORK_PLANE = vpcDMIS_Cmd.GetText(WORK_PLANE, 1) vCPLANE_DISTANCE = vpcDMIS_Cmd.GetText(DISTANCE, 1) sPuffer1 = vpcDMIS_Cmd.GetToggleString(AUTO_CLEAR_PLANE, 0) N1 = InStr(1, sPuffer1, "|") sPuffer2 = Trim(Mid(sPuffer1, N1 + 1, Len(sPuffer1))) sPuffer1 = vpcDMIS_Cmd.GetText(AUTO_CLEAR_PLANE, 0) If sPuffer2 = sPuffer1 Then bAUTO_CLEAR_PLANE = True Else bAUTO_CLEAR_PLANE = False End If End If ' *** find CLEARANCE_CUBE infos ************** ' ... ' *** find MOVE_CLEARP infos ************** If vpcDMIS_Cmd.Type = MOVE_CLEARP Then bMOVE_CLEARP = True End If ' *** find last Hit infos ************** vN_HITS = vpcDMIS_Cmd.GetText(N_HITS, 0) If (vN_HITS <> "") Or (vpcDMIS_Cmd.Type = BASIC_HIT) Then ' get the theos of the Hit If vpcDMIS_Cmd.Type = BASIC_HIT Then iHitIndex = 0 Else iHitIndex = CInt(vN_HITS) End If vLAST_HIT_X = vpcDMIS_Cmd.GetText(THEO_X, iHitIndex) vLAST_HIT_Y = vpcDMIS_Cmd.GetText(THEO_Y, iHitIndex) vLAST_HIT_Z = vpcDMIS_Cmd.GetText(THEO_Z, iHitIndex) vLAST_HIT_I = vpcDMIS_Cmd.GetText(THEO_I, iHitIndex) vLAST_HIT_J = vpcDMIS_Cmd.GetText(THEO_J, iHitIndex) vLAST_HIT_K = vpcDMIS_Cmd.GetText(THEO_K, iHitIndex) ' reset MOVE_CLEARP bMOVE_CLEARP = False End If ' *** find MOVE_INCREMENT infos ************** If vpcDMIS_Cmd.Type = MOVE_INCREMENT Then ' read the theos of MOVE_INCREMENT vMOVE_INCREMENT_THEO_X = vpcDMIS_Cmd.GetText(THEO_X, 0) vMOVE_INCREMENT_THEO_Y = vpcDMIS_Cmd.GetText(THEO_Y, 0) vMOVE_INCREMENT_THEO_Z = vpcDMIS_Cmd.GetText(THEO_Z, 0) End If ' *** if all infos are presend, we only need increment movement commands ************** If vpcDMIS_Cmd.Type <> MOVE_INCREMENT Then GoTo nextLoopIndex If vpcDMIS_Cmd.Marked = False Then GoTo nextLoopIndex '(cmd is marked, it will not be calculated) ' *** debug ************** sPuffer1 = "" sPuffer1 = sPuffer1 & "vPROBE_ID: " & vPROBE_ID & Chr(13) & Chr(10) sPuffer1 = sPuffer1 & "vPROBE_TIPID: " & vPROBE_TIPID & Chr(13) & Chr(10) sPuffer1 = sPuffer1 & "vPROBE_R: " & vPROBE_R & Chr(13) & Chr(10) sPuffer1 = sPuffer1 & "vRETRACT_DISTANCE: " & vRETRACT_DISTANCE & Chr(13) & Chr(10) sPuffer1 = sPuffer1 & "vWORK_PLANE: " & vWORK_PLANE & Chr(13) & Chr(10) sPuffer1 = sPuffer1 & "vCPLANE_DISTANCE: " & vCPLANE_DISTANCE & Chr(13) & Chr(10) sPuffer1 = sPuffer1 & "vLAST_HIT_X: " & CStr(vLAST_HIT_X) & Chr(13) & Chr(10) sPuffer1 = sPuffer1 & "vLAST_HIT_y: " & CStr(vLAST_HIT_Y) & Chr(13) & Chr(10) sPuffer1 = sPuffer1 & "vLAST_HIT_Z: " & CStr(vLAST_HIT_Z) & Chr(13) & Chr(10) sPuffer1 = sPuffer1 & "vLAST_HIT_I: " & CStr(vLAST_HIT_I) & Chr(13) & Chr(10) sPuffer1 = sPuffer1 & "vLAST_HIT_J: " & CStr(vLAST_HIT_J) & Chr(13) & Chr(10) sPuffer1 = sPuffer1 & "vLAST_HIT_K: " & CStr(vLAST_HIT_K) & Chr(13) & Chr(10) sPuffer1 = sPuffer1 & "vMOVE_INCREMENT_THEO_X: " & CStr(vMOVE_INCREMENT_THEO_X) & Chr(13) & Chr(10) sPuffer1 = sPuffer1 & "vMOVE_INCREMENT_THEO_Y: " & CStr(vMOVE_INCREMENT_THEO_Y) & Chr(13) & Chr(10) sPuffer1 = sPuffer1 & "vMOVE_INCREMENT_THEO_Z: " & CStr(vMOVE_INCREMENT_THEO_Z) & Chr(13) & Chr(10) 'MsgBox sPuffer1 ' *** calculate RETRACT point ************** vRETRACT_HIT_X = (vLAST_HIT_I * (vRETRACT_DISTANCE + vPROBE_R)) + vLAST_HIT_X vRETRACT_HIT_Y = (vLAST_HIT_J * (vRETRACT_DISTANCE + vPROBE_R)) + vLAST_HIT_Y vRETRACT_HIT_Z = (vLAST_HIT_K * (vRETRACT_DISTANCE + vPROBE_R)) + vLAST_HIT_Z ' *** calculate MOVE_CLEARP ************** If bMOVE_CLEARP Then Select Case vWORK_PLANE Case "XPLUS" vRETRACT_HIT_X = vCPLANE_DISTANCE Case "YPLUS" vRETRACT_HIT_Y = vCPLANE_DISTANCE Case "ZPLUS" vRETRACT_HIT_Z = vCPLANE_DISTANCE Case "XMINUS" vRETRACT_HIT_X = vCPLANE_DISTANCE Case "YMINUS" vRETRACT_HIT_Y = vCPLANE_DISTANCE Case "ZMINUS" vRETRACT_HIT_Z = vCPLANE_DISTANCE Case Else End Select End If ' *** calculate destination Point from MOVE_INCREMENT ************** vDESTI_POINT_X = vRETRACT_HIT_X + vMOVE_INCREMENT_THEO_X vDESTI_POINT_Y = vRETRACT_HIT_Y + vMOVE_INCREMENT_THEO_Y vDESTI_POINT_Z = vRETRACT_HIT_Z + vMOVE_INCREMENT_THEO_Z ' *** Insert and delete Command ************** ' Insert new MOVE_POINT Command retval = vpcDMIS_Cmds.InsertionPointAfter(vpcDMIS_Cmd) If retval Then Set vpcDMIS_CmdIn = vpcDMIS_Cmds.Add(MOVE_POINT, True) vpcDMIS_CmdIn.Marked = True retval = vpcDMIS_CmdIn.SetToggleString(1, NORM_RELEARN, 0) retval = vpcDMIS_CmdIn.PutText(CStr(vDESTI_POINT_X), THEO_X, 0) retval = vpcDMIS_CmdIn.PutText(CStr(vDESTI_POINT_Y), THEO_Y, 0) retval = vpcDMIS_CmdIn.PutText(CStr(vDESTI_POINT_Z), THEO_Z, 0) End If ' Delete MOVE_INCREMENT Command retval = vpcDMIS_Cmds.RemoveCommandRange(vpcDMIS_Cmd, vpcDMIS_Cmd) iChanged = iChanged + 1 nextLoopIndex: Next vpcDMIS_Cmd ' --- end ----------------------------------------------------------------------------------------- ErrorHandler: vpcDMIS_App.StatusBar = "Script: " & iLoopIndex & " searched commands | " & iChanged & " changed commands" ' --- free something ------------------------------------------------------------------------------ Set vpcDMIS_Cmd = Nothing Set vpcDMIS_Cmds = Nothing Set vpcDMIS_Part = Nothing Set vpcDMIS_App = Nothing End Sub