Bas code for Get X,Y,Z centrals, of AtiveTip

Hi to all

Please, somebody know the bas code for get the X central, Y central and Z central values of active tip?

Thaks a lot!

Parents

LostL over 5 years ago

This extracts values from the tips and creates points that matches the values. There was something funky with the measured values out though, they are offset by the radius IIRC. The compensation variables for that is likely not correct for a general application. But the code gives you a rough picture of how to work with probes at least.

Function ExtractTips()
Dim ProbeLib As Object
Dim app As Object

  Dim pp As Object
  Dim cmds As Object
  Dim cmd As Object
  Dim part As Object
  Dim Probe As Object
  Dim Tips As Object
  Dim DmisCommand As Object
  Dim Point As Object
  Dim Zcomp As Double
Dim Ycomp As Double
Set app = CreateObject("PCDLRN.Application")
  Set part = app.ActivePartProgram
  Set cmds = part.commands
  app.Visible = False
  Set ProbeLib = part.Probes
  Set Probe = ProbeLib.Item("XXXX") 'insert probe name

  Set Tips = Probe.Tips

  For Each Tip In Tips

        Ycomp = Tip.diam / 2
        Zcomp = -Tip.diam / 2


        Set DmisCommand = cmds.Add(CONTACT_VECTOR_POINT_FEATURE, True)
        DmisCommand.Marked = True
        Set Point = Tip.XYZ
        app.Visible = False
        Ycomp = Tip.MeasDiam / 2
        Zcomp = -Tip.MeasDiam / 2
        ' Set Teoretiskt X  = 0

        retval = DmisCommand.PutText(CStr(Point.X), THEO_X, 0)
        ' Set Teoretiskt Y  = 0
        retval = DmisCommand.PutText(CStr(Point.Y), THEO_Y, 0)
        ' Set Teoretiskt Z  = 0
        retval = DmisCommand.PutText(CStr(Point.Z), THEO_Z, 0)
        ' Set Teoretiskt I  = 0
        retval = DmisCommand.PutText("0", THEO_I, 0)
        ' Set Teoretiskt J  = 1
        retval = DmisCommand.PutText("1", THEO_J, 0)
        ' Set Teoretiskt K  = 0
        retval = DmisCommand.PutText("0", THEO_K, 0)
        ' Set Rapportvektor I  = -0.3930601
        retval = DmisCommand.PutText("-0.3930601", REPORTVEC_I, 0)
        ' Set Rapportvektor J  = -0.0660101
        retval = DmisCommand.PutText("-0.0660101", REPORTVEC_J, 0)
        ' Set Rapportvektor K  = 0.9171403
        retval = DmisCommand.PutText("0.9171403", REPORTVEC_K, 0)
        ' Set Uppdateringsvektor I  = 0.0020008
        retval = DmisCommand.PutText("0.0020008", UPDATEVEC_I, 0)
        ' Set Uppdateringsvektor J  = -0.8883425
        retval = DmisCommand.PutText("-0.8883425", UPDATEVEC_J, 0)
        ' Set Uppdateringsvektor K  = -0.459177
        retval = DmisCommand.PutText("-0.459177", UPDATEVEC_K, 0)
        ' Set Mätt X  = 0
        Set Point = Tip.MeasXYZ
        retval = DmisCommand.PutText(CStr(Point.X), MEAS_X, 0)
        ' Set Mätt Y  = 0
        retval = DmisCommand.PutText(CStr(Point.Y + Ycomp), MEAS_Y, 0)
        ' Set Mätt Z  = 0
        retval = DmisCommand.PutText(CStr(Point.Z + Zcomp), MEAS_Z, 0)
        'MsgBox CStr(Point.Z)
        ' Set Mätt I  = 0
        retval = DmisCommand.PutText("0", MEAS_I, 0)
        ' Set Mätt J  = 1
        retval = DmisCommand.PutText("1", MEAS_J, 0)
        ' Set Mätt K  = 0
        retval = DmisCommand.PutText("0", MEAS_K, 0)
        ' Set Mål-X  = 0
        retval = DmisCommand.PutText("0", TARG_X, 0)
        ' Set Mål-Y  = 0
        retval = DmisCommand.PutText("0", TARG_Y, 0)
        ' Set Mål-Z  = 0
        retval = DmisCommand.PutText("0", TARG_Z, 0)
        ' Set Mål-I  = 0
        retval = DmisCommand.PutText("0", TARG_I, 0)
        ' Set Mål-J  = 1
        retval = DmisCommand.PutText("1", TARG_J, 0)
        ' Set Mål-K  = 0
        retval = DmisCommand.PutText("0", TARG_K, 0)
        ' Set Uppdateringsvektor I  = 0.0020008
        retval = DmisCommand.PutText("0.0020008", UPDATEVEC_I, 0)
        ' Set Uppdateringsvektor J  = -0.8883425
        retval = DmisCommand.PutText("-0.8883425", UPDATEVEC_J, 0)
        ' Set Uppdateringsvektor K  = -0.459177
        retval = DmisCommand.PutText("-0.459177", UPDATEVEC_K, 0)
        ' Set Rapportvektor I  = -0.3930601
        retval = DmisCommand.PutText("-0.3930601", REPORTVEC_I, 0)
        ' Set Rapportvektor J  = -0.0660101
        retval = DmisCommand.PutText("-0.0660101", REPORTVEC_J, 0)
        ' Set Rapportvektor K  = 0.9171403
        retval = DmisCommand.PutText("0.9171403", REPORTVEC_K, 0)
        ' Set ID  = PKT1
        'MsgBox Tip.ID

        retval = DmisCommand.PutText("P" + Tip.ID, ID, 0)
        ' Set Koordinattyp  = REKTANGULÄRA
        retval = DmisCommand.SetToggleString(1, COORD_TYPE, 0)
        ' Set X  = <Aktiv uppriktning>
        retval = DmisCommand.PutText("<Aktiv uppriktning>", RMEASFEATIDX, 0)
        ' Set Y  = <Aktiv uppriktning>
        retval = DmisCommand.PutText("<Aktiv uppriktning>", RMEASFEATIDY, 0)
        ' Set Z  = <Aktiv uppriktning>
        retval = DmisCommand.PutText("<Aktiv uppriktning>", RMEASFEATIDZ, 0)
        ' Set Läge 'Sök nom.'  = NOMINELLT
        retval = DmisCommand.SetToggleString(3, FIND_NOMS_TYPE, 0)
        ' Set Typ av yttjocklek  = INGEN_TJOCKLEK
        retval = DmisCommand.SetToggleString(3, THICKNESS_TYPE, 0)
        ' Set Yttjocklek  = 0
        retval = DmisCommand.PutText("0", F_THICKNESS, 0)
        ' Set Autoval, vinklar  = NEJ
        retval = DmisCommand.SetToggleString(1, AUTO_PH9, 0)
        ' Set Håldetektering  = NEJ
        retval = DmisCommand.SetToggleString(1, VOID_DETECT, 0)
        ' Set Grafisk analys  = NEJ
        retval = DmisCommand.SetToggleString(1, GRAPH_ANALYSIS, 0)
        ' Set Elementmarkering BMP  = NEJ
        retval = DmisCommand.SetToggleString(1, LOCATOR_BMP, 0)
        ' Set WAV-fil, elementmarkering  = NEJ
        retval = DmisCommand.SetToggleString(1, LOCATOR_WAV, 0)
        ' Set Elementmarkering text  =
        retval = DmisCommand.PutText("", COMMENT_FIELD, 0)
        ' Set Mätstrategi  = DEFAULT
        retval = DmisCommand.PutText("DEFAULT", MEASUREMENT_STRATEGY, 0)
        ' Set Visa mäthuvudsparametrar  = JA
        retval = DmisCommand.SetToggleString(2, DISPLAY_PROBE_PARAMETERS, 0)
        ' Set Visa avancerade parametrar  = NEJ
        retval = DmisCommand.SetToggleString(1, DISPLAY_ADVANCED_PARAMETERS, 0)
        ' Set Rörelse före/efter  = NEJ
        retval = DmisCommand.SetToggleString(1, MOVE_TYPE, 0)
        ' Set Avstånd före/efter  = 10
        retval = DmisCommand.PutText("10", F_AUTOMOVE, 0)
        ' Set Visa punkter  = JA
        retval = DmisCommand.PutText("JA", DISPLAY_HITS, 0)


  Next
  app.Visible = True
End Function

Reply

LostL over 5 years ago

Function ExtractTips()
Dim ProbeLib As Object
Dim app As Object

  Dim pp As Object
  Dim cmds As Object
  Dim cmd As Object
  Dim part As Object
  Dim Probe As Object
  Dim Tips As Object
  Dim DmisCommand As Object
  Dim Point As Object
  Dim Zcomp As Double
Dim Ycomp As Double
Set app = CreateObject("PCDLRN.Application")
  Set part = app.ActivePartProgram
  Set cmds = part.commands
  app.Visible = False
  Set ProbeLib = part.Probes
  Set Probe = ProbeLib.Item("XXXX") 'insert probe name

  Set Tips = Probe.Tips

  For Each Tip In Tips

        Ycomp = Tip.diam / 2
        Zcomp = -Tip.diam / 2


        Set DmisCommand = cmds.Add(CONTACT_VECTOR_POINT_FEATURE, True)
        DmisCommand.Marked = True
        Set Point = Tip.XYZ
        app.Visible = False
        Ycomp = Tip.MeasDiam / 2
        Zcomp = -Tip.MeasDiam / 2
        ' Set Teoretiskt X  = 0

        retval = DmisCommand.PutText(CStr(Point.X), THEO_X, 0)
        ' Set Teoretiskt Y  = 0
        retval = DmisCommand.PutText(CStr(Point.Y), THEO_Y, 0)
        ' Set Teoretiskt Z  = 0
        retval = DmisCommand.PutText(CStr(Point.Z), THEO_Z, 0)
        ' Set Teoretiskt I  = 0
        retval = DmisCommand.PutText("0", THEO_I, 0)
        ' Set Teoretiskt J  = 1
        retval = DmisCommand.PutText("1", THEO_J, 0)
        ' Set Teoretiskt K  = 0
        retval = DmisCommand.PutText("0", THEO_K, 0)
        ' Set Rapportvektor I  = -0.3930601
        retval = DmisCommand.PutText("-0.3930601", REPORTVEC_I, 0)
        ' Set Rapportvektor J  = -0.0660101
        retval = DmisCommand.PutText("-0.0660101", REPORTVEC_J, 0)
        ' Set Rapportvektor K  = 0.9171403
        retval = DmisCommand.PutText("0.9171403", REPORTVEC_K, 0)
        ' Set Uppdateringsvektor I  = 0.0020008
        retval = DmisCommand.PutText("0.0020008", UPDATEVEC_I, 0)
        ' Set Uppdateringsvektor J  = -0.8883425
        retval = DmisCommand.PutText("-0.8883425", UPDATEVEC_J, 0)
        ' Set Uppdateringsvektor K  = -0.459177
        retval = DmisCommand.PutText("-0.459177", UPDATEVEC_K, 0)
        ' Set Mätt X  = 0
        Set Point = Tip.MeasXYZ
        retval = DmisCommand.PutText(CStr(Point.X), MEAS_X, 0)
        ' Set Mätt Y  = 0
        retval = DmisCommand.PutText(CStr(Point.Y + Ycomp), MEAS_Y, 0)
        ' Set Mätt Z  = 0
        retval = DmisCommand.PutText(CStr(Point.Z + Zcomp), MEAS_Z, 0)
        'MsgBox CStr(Point.Z)
        ' Set Mätt I  = 0
        retval = DmisCommand.PutText("0", MEAS_I, 0)
        ' Set Mätt J  = 1
        retval = DmisCommand.PutText("1", MEAS_J, 0)
        ' Set Mätt K  = 0
        retval = DmisCommand.PutText("0", MEAS_K, 0)
        ' Set Mål-X  = 0
        retval = DmisCommand.PutText("0", TARG_X, 0)
        ' Set Mål-Y  = 0
        retval = DmisCommand.PutText("0", TARG_Y, 0)
        ' Set Mål-Z  = 0
        retval = DmisCommand.PutText("0", TARG_Z, 0)
        ' Set Mål-I  = 0
        retval = DmisCommand.PutText("0", TARG_I, 0)
        ' Set Mål-J  = 1
        retval = DmisCommand.PutText("1", TARG_J, 0)
        ' Set Mål-K  = 0
        retval = DmisCommand.PutText("0", TARG_K, 0)
        ' Set Uppdateringsvektor I  = 0.0020008
        retval = DmisCommand.PutText("0.0020008", UPDATEVEC_I, 0)
        ' Set Uppdateringsvektor J  = -0.8883425
        retval = DmisCommand.PutText("-0.8883425", UPDATEVEC_J, 0)
        ' Set Uppdateringsvektor K  = -0.459177
        retval = DmisCommand.PutText("-0.459177", UPDATEVEC_K, 0)
        ' Set Rapportvektor I  = -0.3930601
        retval = DmisCommand.PutText("-0.3930601", REPORTVEC_I, 0)
        ' Set Rapportvektor J  = -0.0660101
        retval = DmisCommand.PutText("-0.0660101", REPORTVEC_J, 0)
        ' Set Rapportvektor K  = 0.9171403
        retval = DmisCommand.PutText("0.9171403", REPORTVEC_K, 0)
        ' Set ID  = PKT1
        'MsgBox Tip.ID

        retval = DmisCommand.PutText("P" + Tip.ID, ID, 0)
        ' Set Koordinattyp  = REKTANGULÄRA
        retval = DmisCommand.SetToggleString(1, COORD_TYPE, 0)
        ' Set X  = <Aktiv uppriktning>
        retval = DmisCommand.PutText("<Aktiv uppriktning>", RMEASFEATIDX, 0)
        ' Set Y  = <Aktiv uppriktning>
        retval = DmisCommand.PutText("<Aktiv uppriktning>", RMEASFEATIDY, 0)
        ' Set Z  = <Aktiv uppriktning>
        retval = DmisCommand.PutText("<Aktiv uppriktning>", RMEASFEATIDZ, 0)
        ' Set Läge 'Sök nom.'  = NOMINELLT
        retval = DmisCommand.SetToggleString(3, FIND_NOMS_TYPE, 0)
        ' Set Typ av yttjocklek  = INGEN_TJOCKLEK
        retval = DmisCommand.SetToggleString(3, THICKNESS_TYPE, 0)
        ' Set Yttjocklek  = 0
        retval = DmisCommand.PutText("0", F_THICKNESS, 0)
        ' Set Autoval, vinklar  = NEJ
        retval = DmisCommand.SetToggleString(1, AUTO_PH9, 0)
        ' Set Håldetektering  = NEJ
        retval = DmisCommand.SetToggleString(1, VOID_DETECT, 0)
        ' Set Grafisk analys  = NEJ
        retval = DmisCommand.SetToggleString(1, GRAPH_ANALYSIS, 0)
        ' Set Elementmarkering BMP  = NEJ
        retval = DmisCommand.SetToggleString(1, LOCATOR_BMP, 0)
        ' Set WAV-fil, elementmarkering  = NEJ
        retval = DmisCommand.SetToggleString(1, LOCATOR_WAV, 0)
        ' Set Elementmarkering text  =
        retval = DmisCommand.PutText("", COMMENT_FIELD, 0)
        ' Set Mätstrategi  = DEFAULT
        retval = DmisCommand.PutText("DEFAULT", MEASUREMENT_STRATEGY, 0)
        ' Set Visa mäthuvudsparametrar  = JA
        retval = DmisCommand.SetToggleString(2, DISPLAY_PROBE_PARAMETERS, 0)
        ' Set Visa avancerade parametrar  = NEJ
        retval = DmisCommand.SetToggleString(1, DISPLAY_ADVANCED_PARAMETERS, 0)
        ' Set Rörelse före/efter  = NEJ
        retval = DmisCommand.SetToggleString(1, MOVE_TYPE, 0)
        ' Set Avstånd före/efter  = 10
        retval = DmisCommand.PutText("10", F_AUTOMOVE, 0)
        ' Set Visa punkter  = JA
        retval = DmisCommand.PutText("JA", DISPLAY_HITS, 0)


  Next
  app.Visible = True
End Function

Children

No Data