Script for moving to MOUNT POINT

This will move the current probe to the MOUNT POINT. The point where the CMM moves to changes probes.

As always, no guarantees written or expressed. Feel free to change to your needs.

Hope this is helpful.

Dim DmisApp As Object
Dim DmisPart As Object
Dim DmisCommands As Object
Dim DmisCommand As Object

Sub Part1
  Set DmisApp = CreateObject("PCDLRN.Application")
  Set DmisPart = DmisApp.ActivePartProgram
  Set DmisCommands = DmisPart.Commands
  CommandCount = DmisCommands.Count
  Set DmisCommand = DmisCommands.Item(CommandCount)
  DmisCommands.InsertionPointAfter DmisCommand

' 
' YOU NEED TO FIND THE MOUNT POINT VALUES
' EDIT/PREFERENCES/PROBE_CHANGER/MOUNT POINT
' WRITE THESE DWON TO USE IN THE FOLLOWING SCRIPT
'

' Set MPX To X MOUNT POINT VALUE  
  Set DmisCommand = DmisCommands.Add(ASSIGNMENT, True)
    DmisCommand.Marked = True
    retval = DmisCommand.PutText ("MPX", DEST_EXPR, 0)
    retval = DmisCommand.PutText ("-76.7875", SRC_EXPR, 0)

' Set MPY To Y MOUNT POINT VALUE  
  Set DmisCommand = DmisCommands.Add(ASSIGNMENT, True)
    DmisCommand.Marked = True
    retval = DmisCommand.PutText ("MPY", DEST_EXPR, 0)
    retval = DmisCommand.PutText ("[URL="tel:618.7746"]618.7746[/URL]", SRC_EXPR, 0)

' Set MPZ To Z MOUNT POINT VALUE  
  Set DmisCommand = DmisCommands.Add(ASSIGNMENT, True)
    DmisCommand.Marked = True
    retval = DmisCommand.PutText ("MPZ", DEST_EXPR, 0)
    retval = DmisCommand.PutText ("78.2426", SRC_EXPR, 0)
    
 ' recall the STARTUP alignment
  Set DmisCommand = DmisCommands.Add(RECALL_ALIGN, True)
    DmisCommand.Marked = True
    retval = DmisCommand.SetToggleString (1, INTERNAL_EXTERNAL, 0)
    rtval = DmisCommand.PutText ("STARTUP", REF_ID, 0)
 
' find the active probe tip
  Set DmisCommand = DmisCommands.Add(ASSIGNMENT, True)
    DmisCommand.Marked = True
    retval = DmisCommand.PutText ("VAR_ACTIVE_TIP", DEST_EXPR, 0)
    retval = DmisCommand.PutText ("GETCOMMAND(""SET ACTIVE TIP"",""UP"",1)", SRC_EXPR, 0)

' Set var1 To active tip offsets  
  Set DmisCommand = DmisCommands.Add(ASSIGNMENT, True)
    DmisCommand.Marked = True
    retval = DmisCommand.PutText ("VAR1", DEST_EXPR, 0)
    retval = DmisCommand.PutText ("PROBEDATA(""OFFSET"", VAR_ACTIVE_TIP)", SRC_EXPR, 0)
 
' move the probe 
' CAREFULLY NOTICE THE VARIABLES TO INSERT : 
' MPX-VAR1.X 
' MPY-VAR1.Y
' MPZ-VAR1.Z
  Set DmisCommand = DmisCommands.Add(MOVE_POINT, True)
    DmisCommand.Marked = True
    retval = DmisCommand.SetToggleString (1, NORM_RELEARN, 0)
    retval = DmisCommand.PutText ("-76.7875", THEO_X, 0)
    retval = DmisCommand.PutText ("[URL="tel:618.7746"]618.7746[/URL]", THEO_Y, 0)
    retval = DmisCommand.PutText ("-84.9097", THEO_Z, 0)
  Result = DmisCommand.SetExpression("MPX-VAR1.X", THEO_X,0)
  Result = DmisCommand.SetExpression("MPY-VAR1.Y", THEO_Y,0)
  Result = DmisCommand.SetExpression("MPZ-VAR1.Z", THEO_Z,0)
  
End Sub

Sub Main

  Part1

  DmisPart.RefreshPart
End Sub

dph51 over 11 years ago

To Move to Mount Point either for INCH or METRIC machine setting.

'this evaluates for INCH or METRIC


Dim DmisApp As Object
Dim DmisPart As Object
Dim DmisCommands As Object
Dim DmisCommand As Object

Sub Part1
  Set DmisApp = CreateObject("PCDLRN.Application")
  Set DmisPart = DmisApp.ActivePartProgram
  Set DmisCommands = DmisPart.Commands
  CommandCount = DmisCommands.Count
  Set DmisCommand = DmisCommands.Item(CommandCount)
  DmisCommands.InsertionPointAfter DmisCommand
      
 ' recall the STARTUP alignment
  Set DmisCommand = DmisCommands.Add(RECALL_ALIGN, True)
    DmisCommand.Marked = True
    retval = DmisCommand.SetToggleString (1, INTERNAL_EXTERNAL, 0)
    retval = DmisCommand.PutText ("STARTUP", REF_ID, 0)

Dim vari2 As Variant
   vari2 = DmisPart.UNITS

If vari2 > 0 Then
' this evaluates As METRIC
' you need To find the mount point values
' go To  EDIT/PREFERENCES/PROBE_CHANGER/MOUNT POINT
'      
  Set DmisCommand = DmisCommands.Add(ASSIGNMENT, True)
    DmisCommand.Marked = True
    retval = DmisCommand.PutText ("MPX", DEST_EXPR, 0)
    retval = DmisCommand.PutText ("-76.7875", SRC_EXPR, 0)
  
  Set DmisCommand = DmisCommands.Add(ASSIGNMENT, True)
    DmisCommand.Marked = True
    retval = DmisCommand.PutText ("MPY", DEST_EXPR, 0)
    retval = DmisCommand.PutText ("618.7746", SRC_EXPR, 0)
  
  Set DmisCommand = DmisCommands.Add(ASSIGNMENT, True)
    DmisCommand.Marked = True
    retval = DmisCommand.PutText ("MPZ", DEST_EXPR, 0)
    retval = DmisCommand.PutText ("78.2426", SRC_EXPR, 0)
  
' find the last active probe tip
  Set DmisCommand = DmisCommands.Add(ASSIGNMENT, True)
    DmisCommand.Marked = True
    retval = DmisCommand.PutText ("VAR_ACTIVE_TIP", DEST_EXPR, 0)
    retval = DmisCommand.PutText ("GETCOMMAND(""SET ACTIVE TIP"",""UP"",1)", SRC_EXPR, 0)

' Set var1 To active tip offsets  
  Set DmisCommand = DmisCommands.Add(ASSIGNMENT, True)
    DmisCommand.Marked = True
    retval = DmisCommand.PutText ("VAR1", DEST_EXPR, 0)
    retval = DmisCommand.PutText ("PROBEDATA(""OFFSET"", VAR_ACTIVE_TIP)", SRC_EXPR, 0)
  
  Set DmisCommand = DmisCommands.Add(MOVE_POINT, True)
    DmisCommand.Marked = True
    retval = DmisCommand.SetToggleString (1, NORM_RELEARN, 0)
    retval = DmisCommand.PutText ("-76.7875", THEO_X, 0)
    retval = DmisCommand.PutText ("618.7746", THEO_Y, 0)
    retval = DmisCommand.PutText ("-84.9097", THEO_Z, 0)
  Result = DmisCommand.SetExpression("MPX-VAR1.X", THEO_X, 0)
  Result = DmisCommand.SetExpression("MPY-VAR1.Y", THEO_Y, 0)
  Result = DmisCommand.SetExpression("MPZ-VAR1.Z", THEO_Z, 0)
  
Else
' this evaluates As INCH
' you need To find the mount point values
' go To  EDIT/PREFERENCES/PROBE_CHANGER/MOUNT POINT
'      
  Set DmisCommand = DmisCommands.Add(ASSIGNMENT, True)
    DmisCommand.Marked = True
    retval = DmisCommand.PutText ("MPX", DEST_EXPR, 0)
    retval = DmisCommand.PutText ("-3.02313", SRC_EXPR, 0)
  
  Set DmisCommand = DmisCommands.Add(ASSIGNMENT, True)
    DmisCommand.Marked = True
    retval = DmisCommand.PutText ("MPY", DEST_EXPR, 0)
    retval = DmisCommand.PutText ("24.3612", SRC_EXPR, 0)
  
  Set DmisCommand = DmisCommands.Add(ASSIGNMENT, True)
    DmisCommand.Marked = True
    retval = DmisCommand.PutText ("MPZ", DEST_EXPR, 0)
    retval = DmisCommand.PutText ("3.08042", SRC_EXPR, 0)
  
' find the last active probe tip
  Set DmisCommand = DmisCommands.Add(ASSIGNMENT, True)
    DmisCommand.Marked = True
    retval = DmisCommand.PutText ("VAR_ACTIVE_TIP", DEST_EXPR, 0)
    retval = DmisCommand.PutText ("GETCOMMAND(""SET ACTIVE TIP"",""UP"",1)", SRC_EXPR, 0)

' Set var1 To active tip offsets  
  Set DmisCommand = DmisCommands.Add(ASSIGNMENT, True)
    DmisCommand.Marked = True
    retval = DmisCommand.PutText ("VAR1", DEST_EXPR, 0)
    retval = DmisCommand.PutText ("PROBEDATA(""OFFSET"", VAR_ACTIVE_TIP)", SRC_EXPR, 0)
  
  Set DmisCommand = DmisCommands.Add(MOVE_POINT, True)
    DmisCommand.Marked = True
    retval = DmisCommand.SetToggleString (1, NORM_RELEARN, 0)
    retval = DmisCommand.PutText ("-3.02313", THEO_X, 0)
    retval = DmisCommand.PutText ("24.3612", THEO_Y, 0)
    retval = DmisCommand.PutText ("3.08042", THEO_Z, 0)
  Result = DmisCommand.SetExpression("MPX-VAR1.X", THEO_X, 0)
  Result = DmisCommand.SetExpression("MPY-VAR1.Y", THEO_Y, 0)
  Result = DmisCommand.SetExpression("MPZ-VAR1.Z", THEO_Z, 0)
End If   

End Sub

Sub Main

  Part1

  DmisPart.RefreshPart
End Sub