Finding all GeoTol Profile of a Surface with no datums (part 2)

Ok, I'm going to do my best to describe my problem. (Apologies for my most recent question of the same name, I essentially gave no specifics.)

History: Roughly a year ago, we started using a different software package to track our inspections. Because of this, we were forced to use GeoTol instead of legacy.

Recent History: We discovered that when we have profile of a surface without any Datums, that GeoTol will roll the part around, trying to best fit the points. This is giving us false positives.

Therefore, we need to go through all of our programs, (6,300 of them) looking for GeoTol Profile of Surface with no datums to make sure that we have multi-level scans which will keep the part from being rotated by PC-DMIS.

I have a MS Access database with a table that I'm writing the path of the program to. Here is the salient portion of the code:

Const DIMENSION_PROFILE = 1105
Const DIMENSION_PROFILE_LINE = 1118
Const DIMENSION_PROFILE_SURFACE = 1105
Const ASME_TOLERANCE_COMMAND = 1302

Const DIMOUTPUT_BOTH = 2
Const DIMOUTPUT_NONE = 3
Const DIMOUTPUT_REPORT = 1
Const DIMOUTPUT_STATS = 0

Public Sub ProcessFile(directory_path As String, file_path As String, file_name As String, temp_path As String)

Dim DmisCommands As Object
Dim DmisCommand As Object
Dim FCFCommand As Object
Dim DimensionCommand As Object
Dim program_name As String
Dim command_count As Integer
Dim status_bar_text As String
Dim copy_file_path As String
Dim dimension_name As String

numberOfFilesProcessed = numberOfFilesProcessed + 1
copy_file_path = fso.BuildPath(temp_path, file_name)
fso.CopyFile file_path, copy_file_path

Set DmisPart = DmisParts.Open(copy_file_path, "OFFLINE")
Set DmisCommands = DmisPart.Commands

program_name = DmisPart.Name

For Each DmisCommand In DmisCommands
    If DmisCommand.Type = ASME_TOLERANCE_COMMAND Then

      dimension_name = DmisCommand.ID
      Set DimensionCommand = DmisCommand.DimensionCommand
      If Not DimensionCommand Is Nothing Then
        If DimensionCommand.OutputMode = DIMOUTPUT_BOTH Then
          If DimensionCommand.IsProfileDimension Then
            If DimensionCommand.Datum1 = "" Then
              CurrentDb.Execute "Insert into tblCMMPrograms (FilePath) Values ('" + file_path + "')"
              GoTo do_next
            End If
          End If
        End If
      End If

End If

Next
do_next:

  DmisPart.Quit
  Set DmisCommand = Nothing
  Set DmisPart = Nothing
  Set DmisCommands = Nothing
  fso.DeleteFile copy_file_path

End Sub

My problem is how to get at the Profile dimension when it's GeoTol.

Specifcally, I have a test program INSP_61 that is a GeoTol profile dimension, but as I'm iterating through all the commands, I can't ask "are you a profile of a surface dimension?" because it's not. It's a ASME_TOLERANCE_COMMAND.

So then, when I try to cast this command to a Dimension Command so that I can ask about its datums, it doesn't work.

How do I get at the profile of a GeoTol profile command so that I can ask two questions:

1. Are you profile of a surface?

2. Do you have any Datums?

If the answer to question 1 is Yes, and the answer to question 2 is no, then I want to write the path of this program to my database table.

Any help would be very much appreciated.

0 Henniger123 8 months ago

hi, I just replied to your first post:

here is a basic script that does this, you can start it from pcDMIS or as an Excel macro.
Output goes to "C:\Users\Public\Documents\ProfilSearchOutput.txt"

only works with geotol profile

Sub Main()
 ' Error
   On Error Resume Next

 ' Dim something
   Dim DmisApp As Object
   Dim DmisPart As Object
   Dim DmisCommands As Object
   Dim DmisCommand As Object
   Set DmisApp = CreateObject("PCDLRN.Application")
   Set DmisPart = DmisApp.ActivePartProgram
   Set DmisCommands = DmisPart.Commands

   Dim iCmdCount, iProfilCount, iNoDatumCount As Integer
   Dim sPath As String
   'sPath = DmisApp.GetSystemDocuments(False)
   sPath = "C:\Users\Public\Documents\ProfilSearchOutput.txt"

 ' open file
   Open sPath For Output As #1
   Print #1, DmisPart.FullName
   Print #1, DmisPart.ProgramVersionName
   Print #1, " "

 ' search part
   iCmdCount = 0
   iProfilCount = 0
   iNoDatumCount = 0
   For Each DmisCommand In DmisCommands
     iCmdCount = iCmdCount + 1
     If (DmisCommand.Type = ISO_TOLERANCE_COMMAND) Or (DmisCommand.Type = ASME_TOLERANCE_COMMAND) Then
       'retval = DmisCommand.SetToggleString(8, SEGMENT_TYPE_TOGGLE, 1) -> line
       'retval = DmisCommand.SetToggleString(9, SEGMENT_TYPE_TOGGLE, 1) -> plane
       If (DmisCommand.GetToggleValue(SEGMENT_TYPE_TOGGLE, 1) = 8) Or (DmisCommand.GetToggleValue(SEGMENT_TYPE_TOGGLE, 1) = 9) Then
         iProfilCount = iProfilCount + 1
         If DmisCommand.GetTextEx(DATUM_ID, 1, "SEG=1") = "" Then
           iNoDatumCount = iNoDatumCount + 1
           Print #1, "Nr: " & CStr(iCmdCount) & " " & DmisCommand.ID
         End If
       End If
     End If
   Next DmisCommand
   
 ' close file
   Print #1, " "
   Print #1, "Command Count: " & CStr(iCmdCount)
   Print #1, "Profil Count: " & CStr(iProfilCount)
   Print #1, "no Datum Count: " & CStr(iNoDatumCount)
   Close #1

 ' unDim something
   Set DmisCommand = Nothing
   Set DmisCommands = Nothing
   Set DmisPart = Nothing
   Set DmisApp = Nothing
End Sub

the script should be adaptable to your needs