Script to Generate Raw Point Data

  • Filter
  • Time
  • Show
Clear All
new posts

  • Script to Generate Raw Point Data

    A nearby Community College has a Romer absolute arm that has been setting unused for several years. I recently retired from an engineering career and have volunteered to get the arm up and running so the students can learn some basic concepts about CMM. The school has lost their USB key license for the PC-DMIS software and it will be several months before they look at budgets and getting the software might not make the cut.

    I would like to get something very basic going just so the students can try the arm. My thought was to create a simple script that would allow the student to digitize several points and then save them to a text file. They could then import those points into their CAD software and generate features off the points. From there they could generate an stl file and print something with their 3D printer. So the lesson would be more related to reverse engineering as opposed to part validation.

    A simple script that would just collect a bunch of points seems like it would be easy to create. No need to create any alignments or other features, just capture a series of raw point locations. I've got some experience with programming, but not with DMIS. It would be great if someone had had a script that would do this?

    Any help you can provide would be greatly appreciated.

    Thank you!

  • #2
    If you´re going to do it without PC-DMIS I would start by talking with the manufacturer about drivers/software interfaces.


    • #3
      here's my script to CSV export measured values from measured or DCC features including all hit points. Maybe it will help.

      Dim PCDapp As Object
      Dim PCDpart As Object
      Dim Cmds As Object
      Dim Cmd As Object
      Dim FCmd As Object
      Dim fs As Object
      Dim oPointData As Object
      Dim oHitData As Object

      Dim x#, y#, z#, x2#, y2#, z2#, x3#, y3#, z3#
      Dim i#, j#, k#, i2#, j2#, k2#
      Dim d#, l#, h#, a#, w#
      Dim hitXYZ#(3), hitNum%, numhits%
      Dim CmdID$, Batch$, Num$, FileTime$, FileName$, FilePath$
      Dim Spc$, AlgnID$

      Sub Main

      Set PCDapp = CreateObject("PCDLRN.Application")
      Set oPointData = CreateObject("PCDLRN.PointData")
      Set oHitData = CreateObject("PCDLRN.PointData")
      Set PCDpart = PCDapp.ActivePartProgram
      Set Cmds = PCDpart.Commands

      Set fs = CreateObject("Scripting.FileSystemObject")

      FilePath = PCDpart.Path & "\data"

      If Not(fs.FolderExists (FilePath)) Then
      retval = fs.CreateFolder(FilePath)
      End If

      FileTime = Format(Now, "ddmmyyhhnn")
      FileName = FilePath & FileTime & ".csv"

      Open FileName For Append As #1
      Close #1

      Open FileName For Output As #1

      For Each Cmd In Cmds

      If Cmd.IsAlignment And Cmd.ID <> "" Then
      AlgnID = Cmd.ID
      End If

      If Cmd.Type = RECALL_ALIGN Then
      AlgnID = cmd.GetText(REF_ID, 0)
      End If

      If Cmd.IsFeature Or Cmd.IsScan Then
      If Cmd.ID <> "" Then
      If Cmd.IsDCCFeature Or Cmd.IsMeasuredFeature Or Cmd.IsScan Then
      CmdID = Cmd.ID
      Set FCmd = Cmd.FeatureCommand

      retval = FCmd.GetData(oPointData, FDATA_CENTROID, FDATA_MEAS, FDATA_PART, AlgnID, PLANE_TOP)
      x = oPointData.X
      y = oPointData.Y
      z = oPointData.Z

      retval = FCmd.GetData(oPointData, FDATA_VECTOR, FDATA_MEAS, FDATA_PART, AlgnID, PLANE_TOP)
      i = oPointData.I
      j = oPointData.J
      k = oPointData.K

      Select Case Cmd.Feature

      Case F_CIRCLE
      d = FCmd.MeasDiam
      If FCmd.MeasHeight <> 0 Then
      h = FCmd.MeasHeight
      End If

      Case F_CONE
      a = FCmd.MeasAngle
      d = FCmd.MeasDiam
      l = FCmd.MeasLength

      Case F_CYLINDER
      d = FCmd.MeasDiam
      l = FCmd.MeasLength

      Case F_ELLIPSE
      l = FCmd.MeasMajorAxis
      w = FCmd.MeasMinorAxis
      retval = FCmd.GetData(oPointData, FDATA_SLOT_VECTOR, FDATA_MEAS, FDATA_PART, AlgnID, PLANE_TOP)
      i2 = oPointData.I
      j2 = oPointData.J
      k2 = oPointData.K

      Case F_LINE
      l = FCmd.MeasLength
      i2 = oPointData.I
      j2 = oPointData.J
      k2 = oPointData.K
      retval = FCmd.GetData(oPointData, FDATA_STARTPOINT, FDATA_MEAS, FDATA_PART, AlgnID, PLANE_TOP)
      x2 = oPointData.X
      y2 = oPointData.Y
      z2 = oPointData.Z
      retval = FCmd.GetData(oPointData, FDATA_ENDPOINT, FDATA_MEAS, FDATA_PART, AlgnID, PLANE_TOP)
      x3 = oPointData.X
      y3 = oPointData.Y
      z3 = oPointData.Z

      Case F_SLOT
      d = FCmd.MeasDiam
      h = FCmd.MeasHeight
      l = FCmd.MeasLength
      retval = FCmd.GetData(oPointData, FDATA_SLOT_VECTOR, FDATA_MEAS, FDATA_PART, AlgnID, PLANE_TOP)
      i2 = oPointData.I
      j2 = oPointData.J
      k2 = oPointData.K

      Case F_SPHERE
      d = FCmd.MeasDiam

      End Select

      'x = Format(x, "0.00000;-0.00000")
      'y = Format(y, "0.00000;-0.00000")
      'z = Format(z, "0.00000;-0.00000")
      'x2 = Format(x2, "0.00000;-0.00000")
      'y2 = Format(y2, "0.00000;-0.00000")
      'z2 = Format(z2, "0.00000;-0.00000")
      'x3 = Format(x3, "0.00000;-0.00000")
      'y3 = Format(y3, "0.00000;-0.00000")
      'z3 = Format(z3, "0.00000;-0.00000")
      'i = Format(i, "0.00000;-0.00000")
      'j = Format(j, "0.00000;-0.00000")
      'k = Format(k, "0.00000;-0.00000")
      'i2 = Format(i2, "0.00000;-0.00000")
      'j2 = Format(j2, "0.00000;-0.00000")
      'k2 = Format(k2, "0.00000;-0.00000")
      'd = Format(d, "0.00000;-0.00000")
      'l = Format(l, "0.00000;-0.00000")
      'h = Format(h, "0.00000;-0.00000")
      'a = Format(a, "0.00000;-0.00000")
      ' w = Format(w, "0.00000;-0.00000")

      Call WriteToFile

      numhits = FCmd.NumHits
      If numhits > 0 Then
      For hitNum = 1 To numhits
      hitXYZ#(1) = oHitData.X 'Format(oHitData.X, "0.00000;-0.00000")
      hitXYZ#(2) = oHitData.Y 'Format(oHitData.Y, "0.00000;-0.00000")
      hitXYZ#(3) = oHitData.Z 'Format(oHitData.Z, "0.00000;-0.00000")
      Write #1, hitNum, hitXYZ(1), hitXYZ(2), hitXYZ(3)
      Next hitNum
      End If
      End If
      End If
      End If
      Next Cmd

      Close #1

      Call csvSave

      Set PCDapp = Nothing
      Set PCDpart = Nothing
      Set Cmds = Nothing
      Set Cmd = Nothing
      Set FCmd = Nothing
      Set fs = Nothing
      Set oPointData = Nothing
      Set oHitData = Nothing

      End Sub

      Function csvSave

      Dim xlApp As Object
      Dim xlWorkbooks As Object
      Dim xlWorkbook As Object

      Set xlApp = CreateObject("Excel.Application")
      Set xlWorkbooks = xlApp.Workbooks
      Set xlWorkbook = xlWorkbooks.Open(FileName)

      Set xlWorkbook = Nothing
      Set xlWorkbooks = Nothing
      Set xlApp = Nothing
      End Function

      Function WriteToFile

      Spc = ""
      Select Case Cmd.Feature

      Case F_CIRCLE
      If FCmd.TheoHeight = 0 Then
      Write #1, CmdID, x, y, z, i, j, k, d
      Write #1, CmdID, x, y, z, i, j, k, d, h
      End If

      Case F_CONE
      Write #1, CmdID, x, y, z, i, j, k, d, Spc, l, Spc, a

      Case F_CYLINDER
      Write #1, CmdID, x, y, z, i, j, k, d, Spc, l

      Case F_ELLIPSE
      Write #1, CmdID, x, y, z, i, j, k, Spc, Spc, l, w, Spc, i2, j2, k2

      Case F_LINE
      Write #1, CmdID, x, y, z, i, j, k, Spc, Spc, l, Spc, Spc, i2, j2, k2, x2, y2, z2, x3, y3, z3

      Case F_SLOT
      Write #1, CmdID, x, y, z, i, j, k, d, h, l, Spc, Spc, i2, j2, k2

      Case F_SPHERE
      Write #1, CmdID, x, y, z, i, j, k, d

      Case Else
      Write #1, CmdID, x, y, z, i, j, k

      End Select

      End Function


      • #4
        Can they run PC-DMIS or not? If not, then you are looking at building an app that captures the communication from the Romer arm and converting that to points. A sizeable endeavour, I might add...
        PC-DMIS CAD++ 2o23.1


        • #5
          Maybe look into the Romer software and see what's available there. I know that some measurements can be done, but I don't know if there's a way to export the data.

          I don't think the Romer software is depending on the PC-DMIS portlock.
          SW support - Hexagon Metrology Nordic AB


          • #6
            Thanks everyone!

            I'm pretty sure we can't run PC-DMIS, which is why I just wanted to capture point data. I think I have a work around. There are some diagnostics scripts in the RDS library. If I run one of those I notice that it creates an output file with a bunch of information, including the raw values of the measured data. I can write a Perl script that will parse out the measured point information. The only shortcoming is that they only capture nine points at a time. At least it's a start.

            Thanks again!


            Related Topics


            • JoeRZ
              to points
              by JoeRZ
              Hello All,

              Was wonderin if I can get any suggestions to convert my measured features into individual point hits.

              I was requested...
              01-14-2015, 11:39 AM
            • kaikai
              VB Script
              by kaikai
              I am new to PC-DMIS script. I am trying to read the script examples in the “Wizards” folder that comes with the installation. However, they are all...
              06-09-2017, 01:44 PM
            • Virgil UK
              Scripting for 'to points'
              by Virgil UK
              Good Morning

              I have several linear scans that I would like to break the hits out of into individual points. I was aware that there might...
              02-05-2019, 06:55 AM
            • Jan d.
              SCRIPTS suddenly quit working
              by Jan d.
              I was trying some new BASIC scripts this morning when suddenly all scripts are now failing to run. Has anybody ever had that happen? None of my scripts...
              12-06-2006, 12:18 PM
            • jon_dav_uk
              Running Basic Scripts
              by jon_dav_uk
              OK I am completly baffled and am hoping someone out there can help me with some very basic scripting. I will try my best to explain below what I have...
              10-25-2006, 12:35 PM