hexagon logo
Register Sign in
  • Replies 13 replies
  • Subscribers 30 subscribers
  • Views 177 views
  • Users 0 members are here
Options
Related

Need CSV Output Help...

SunfireSSR
This is the code I have to output to a CSV file using VB6. It gives me all the feature names, but only gives the values for any TP or form Features. It will not give me values for Diameters or distances. It returns "0".

Any help would be appreciated... Thanks !!!

Start of Code ***********************************************

Sub Main()
Dim strSQL As String
Dim strTBL As String
Dim strVAL As String


'PCDMIS declarations
'--------------------
Dim App As PCDLRN.Application
Dim Part As PCDLRN.PartProgram
Dim Cmds As PCDLRN.Commands
Dim Cmd As PCDLRN.Command
Dim DCmd As PCDLRN.DimensionCmd

Set App = CreateObject("PCDLRN.Application.4.2")
Set Part = App.ActivePartProgram
Set Cmds = Part.Commands

Dim Var As Object
Dim Var1 As Object
Dim Var2 As Object

Set Var = App.ActivePartProgram.GetVariableValue("CMM_NO")
Set Var1 = App.ActivePartProgram.GetVariableValue("CELL_NO")
Set Var2 = App.ActivePartProgram.GetVariableValue("MACH_NO")

Dim PartNo As String
Dim CellNo As String
Dim MachNo As String
Dim Charpos As Integer
Dim Dev_Val As Double
Dim Tmp_Val As Double
Dim FeatName As String

'===========================================================================
' SECTION 1 - Get Part, Cell, Machine and CMM Number from program
'===========================================================================
'Following variables must be defined in CMM program
' CELL_NO
' MACH_NO
'----------------------------------------------------------------------------
PartNo = Left(Part, 5)
CellNo = Var1.StringValue
MachNo = Var2.StringValue
CellNo = 4
MachNo = 2
'MsgBox "CELL = " & CellNo & " MACH = " & MachNo & "CMM = " & CmmNo

'===============================================================================
' SECTION 2 - Get Features / Dimensions and Start Building the Table and Value strings and
' get the Feature and Value Info...
'===============================================================================
If (Not App Is Nothing) Then
Set Part = App.ActivePartProgram

If (Not Part Is Nothing) Then
Set Cmds = Part.Commands

strTBL = "INSERT INTO MBHData (PART, CELL, MACH, "
strVAL = "VALUES ('" & PartNo & "', '" & CellNo & "', '" & MachNo & "'"

For Each Cmd In Cmds
FeatName = ""
If Cmd.IsDimension Then
Set DCmd = Cmd.DimensionCommand
FeatName = DCmd.ID
Dev_Val = Round(DCmd.Deviation, 4)

'If DCmd.ID <> "" Then
'If Cmd.Type = DIMENSION_START_LOCATION Or _
'Cmd.Type = DIMENSION_END_LOCATION Or _
'Cmd.Type = DIMENSION_TRUE_START_POSITION Or _
'Cmd.Type = DIMENSION_TRUE_END_POSITION

'Select Case Cmd.Type

'Case DIMENSION_2D_DISTANCE
'FeatName = DCmd.ID
'Dev_Val = Round(DCmd.Deviation, 4)

'Case Else
'If DCmd.AxisLetter <> "" Then
'Dev_Val = Round(DCmd.Deviation, 4)
'End If
'End Select
'End If
'End If

ElseIf (Cmd.Type = FEATURE_CONTROL_FRAME) Then
FeatName = Cmd.ID
Tmp_Val = Cmd.GetText(LINE2_DEV, 1)
Dev_Val = Round(Tmp_Val, 4)
End If
' In order to match FeatureNames correctly from PC-DMIS, this will strip
' any of them that have "__XX__" (for tolerance warnings) in them.
' example (HUB ID__66__make an offset) gets stripped to HUB ID...

'MsgBox FeatName
Charpos = InStr(1, FeatName, "_", vbTextCompare)
If Charpos > 0 Then
FeatName = Left(FeatName, Charpos - 1)
End If
'MsgBox FeatName

'*********************************************************************
' These are the FeatureName to Tablename descriptors that build
' the strTBL and strVAL strings based on what is in the Part Program.
' Always update this area when you add NEW features to the PC-DMIS programs.
' Note - Keep the same format below when adding or removing features
' because you'll never have the same starting or ending features
' from program to program.
' It does not matter what order you put them in here either
'*********************************************************************

' *************************************************************************
' Start of Feature Names and Table Names...
' *************************************************************************

Select Case FeatName
Case "THRUST FACE FLATNESS"
strTBL = strTBL & "TFFLT, "
strVAL = strVAL & "," & Dev_Val
Case "V11"
strTBL = strTBL & "V11, "
strVAL = strVAL & "," & Dev_Val
Case "HUB ID"
strTBL = strTBL & "HID, "
strVAL = strVAL & "," & Dev_Val
Case "HUB ID TAPER"
strTBL = strTBL & "HTAP, "
strVAL = strVAL & "," & Dev_Val
Case "MAJOR OD"
strTBL = strTBL & "MAJOD, "
strVAL = strVAL & "," & Dev_Val
Case "HOLE A TRUE POSITION"
strTBL = strTBL & "AHTP, "
strVAL = strVAL & "," & Dev_Val
Case "HOLE B TRUE POSITION"
strTBL = strTBL & "BHTP, "
strVAL = strVAL & "," & Dev_Val
Case "STAKE HOLE D TRUE POSITION"
strTBL = strTBL & "SHDTP, "
strVAL = strVAL & "," & Dev_Val
Case "STAKE HOLE E TRUE POSITION"
strTBL = strTBL & "SHETP, "
strVAL = strVAL & "," & Dev_Val
Case "TREPAN ID"
strTBL = strTBL & "TRPID, "
strVAL = strVAL & "," & Dev_Val
Case "TREPAN OD"
strTBL = strTBL & "TRPOD, "
strVAL = strVAL & "," & Dev_Val
Case "PAD HEIGHT"
strTBL = strTBL & "PADH, "
strVAL = strVAL & "," & Dev_Val
Case "DOWEL SPREAD"
strTBL = strTBL & "DWLSP, "
strVAL = strVAL & "," & Dev_Val
End Select

' *************************************************************************
' End of Feature Names and Table Names...
' *************************************************************************
Next Cmd

Set Part = Nothing
End If
Set App = Nothing
End If

'===============================================================================
' SECTION 3 - Clean up the strTBL and strVAL strings...
'===============================================================================
'This removes the last "comma" and "space" and appends a "closing parenthesis"...
strTBL = Left(strTBL, Len(strTBL) - 2)
strTBL = strTBL & ")"

'This appends a "closing parenthesis"...
strVAL = strVAL & ")"

'Now, combine the strTBL and strVAL strings for output as strSQL...
strSQL = strTBL & strVAL

' This is the Write the File command...
writeFile (strSQL)

' This tell me it's DONE !!!
MsgBox "Done"
End Sub

'===============================================================================
' SECTION 4 - Write the data to a CSC file (for testing only)
'===============================================================================

Public Function writeFile(strSQL)
Dim FileSQL As Integer
On Error GoTo ErrHandler
FileSQL = FreeFile

Open "c:\DATA\query.txt" For Output As #FileSQL
Print #FileSQL, strSQL
Close #FileSQL

Exit Function

ErrHandler:
MsgBox ("Can't open the CSV file")
End Function

End of Code ***********************************************
  • Ok, a couple of things and this is just a quick stab in the dark. Your file is set up to handle feature control frames and axis output it appears, from what you said it's doing TP and form correctly so I'm going to assume that it's handling the FCF's ok. I'm working on 3.7 and strictly in legacy style dimensions so it's good that that is working 'cause I haven't dealt with those. As for diameters and distances I am assuming that those are being output "old style".

    The only thing that I can guess from here is that it's not handling those correctly. When I created a CSV routine I found that old style dims actually had a few different components to them, a header, dimensions, and a close line. If I had to guess your program is only handling the header portion and not the actual dimensions. That would cause a return value of 0 on this line: Dev_Val = Round(DCmd.Deviation, 4). That would be because there is no deviation value in the header line you have to go to the next portion of the dimension command for that information and I think it's skipping that and going to the next dim command. But all of this is just a guess on my part without being able to test this out myself.

    The only really big differance I can see that MAY cause this is in the NEXT command. In my script I only used Next and not Next Cmd. I wonder if this is causing my program to read the next line while yours goes on to the next dimension command. Again, I'm only guessing here and I don't know if changing that will work or maybe mess up the FCF output.

    Sorry I couldn't be more help but if it help any here is what I did:

    http://www.pcdmisforum.com/showthread.php?t=16586
  • Thanks EHines... As you know, it's hard to grab something when you don't know what it looks like. If I knew what the data structure actually was, I could get it, but I'm fishing in the Dark here. I have tried Deviation and Measured both with no avail. I am using PC-DMIS CAD 4.2 MR2.
  • Are you looking for the diameters and dimensions FROM a FCF evaluation or from a LOCATION evaluation?

    Also, for futureproofing (and earlier versions) change this 

    Set App = CreateObject("PCDLRN.Application.4.2")


    ...to... 

    Set App = CreateObject("PCDLRN.Application")
  • Thanks for your response vpt.se...
    I'm looking for the diameter from a location, not a FCF...

    Will make the changes you requested...
  • Made a fast script to test if there were any problems getting the info from within the PC-DMIS environment: 

    Sub main()
  Dim App As Object
  Dim Part As Object
  Dim Commands As Object
  Dim Command As Object
  Dim Dimension As Object

  Dim cnt As Integer
  Dim ID As String
  Dim Dev, Nom As Double

 Set App = CreateObject("PCDLRN.Application")
 Set Part = App.ActivePartProgram
 Set Commands = Part.Commands

 For cnt = 1 To Commands.Count
    Set Command = Commands(cnt)
    If Command.IsDimension Then
      Set Dimension = Command.DimensionCommand
      ID = Dimension.ID
      If Dimension.AxisLetter = "D" Then
        Dev = Dimension.Deviation
        Nom = Dimension.Nominal
        MsgBox ID & Dimension.AxisLetter & " " & Nom & " " & Dev
      End If
    End If
Next
End Sub


    Which works fine.

    I don't know if this could be it, but isn't there a 'THEN' lacking from this code? 

    'If Cmd.Type = DIMENSION_START_LOCATION Or _
'Cmd.Type = DIMENSION_END_LOCATION Or _
'Cmd.Type = DIMENSION_TRUE_START_POSITION Or _
'Cmd.Type = DIMENSION_TRUE_END_POSITION
  • Made a fast script to test if there were any problems getting the info from within the PC-DMIS environment:

    Which works fine.

    I don't know if this could be it, but isn't there a 'THEN' lacking from this code? 

    'If Cmd.Type = DIMENSION_START_LOCATION Or _
'Cmd.Type = DIMENSION_END_LOCATION Or _
'Cmd.Type = DIMENSION_TRUE_START_POSITION Or _
'Cmd.Type = DIMENSION_TRUE_END_POSITION


    I thought the same thing until I noticed that those lines are remarked out. Looking at your example I'm still coming back to the NEXT command. I notice that you also didn't use Next Cmd and that works. Sun have you tried to change that line yet? It's a small thing I know but I'm wondering if that makes a differance.

    Nevermind, I just tested it and it works either way.
  • EH: Yes, the original Code had a the at the end of what you show, but that section was blocked off and does not run. Even when it was in the code, I got the same results as what I have now.

    VPT:Give me a bit to run your latest check for me.


    And Thanks Again to BOTH of you for helping me out !!!
  • VPT: Your results yielded "D 1.000 -.027" (I rounded to 3dp). No Feature Name...
  • VPT: Does the difference in these (2) Matter ? ( I know the names don't...)

    Dim App As Object
    Dim Part As Object
    Dim Commands As Object
    Dim Command As Object
    Dim Dimension As Object

    Dim App As PCDLRN.Application
    Dim Part As PCDLRN.PartProgram
    Dim Cmds As PCDLRN.Commands
    Dim Cmd As PCDLRN.Command
    Dim DCmd As PCDLRN.DimensionCmd
  • I added this to my code. I got the same results without the FeatureName and that explains why I'm not getting the values based on the featurenames later in the code.

    If DCmd.AxisLetter <> "" Then
    FeatName = DCmd.ID
    Dev_Val = Round(DCmd.Deviation, 4)
    MsgBox FeatName & " " & DCmd.AxisLetter & " " & Dev_Val
    End If
© 2024 Hexagon AB and/or its subsidiaries. Privacy Policy | Cloud Services Agreement