hexagon logo
Register Sign in
  • Replies 29 replies
  • Subscribers 33 subscribers
  • Views 573 views
  • Users 0 members are here
Options
Related

Dropdown List of Stylus in program

Rploughe
Hello All.

I hit a bump and I can't seem to figure out what I am missing.

I have used dropdown lists before, and I am unaware what I am missing. 

'  Rploughe 2015
'
Sub Main()
Dim App As Object
Dim Part As Object
Dim Cmds As Object
Dim Cmd As Object
Dim PartProbes, PartProbe, ProbeTips, ProbeTip
Dim Prober1
Dim ProbeList$( ) 

'Creat PC-Dmis Commands
Set App = CreateObject("PCDLRN.Application")
Set Part = App.ActivePartProgram
Set Cmds = Part.Commands
serverpath = "Z:\01 Leitz PMM-Xi\probes\" 'Path coded To point To probes folder

'Assign searchpath using "serverpath"
Dim filename As String
Dim count As Integer
Dim ECount As Integer
count = 9000

'Redimension array With correct count of entries
ReDim ProbeList$(Count)
filename = Dir(serverpath & "*.*", 0) 'value of "0" pulls In all files In directory given
Let ECount = "0"
While filename <> ""
    filelength = len(filename)
    delimper = instr(1,filename,".")
    delimp = Right$(filename,(filelength-delimper))
    If delimp = "PRB" Then
         checker = Left$(filename,(filelength-4))
         For Each Cmd In Cmds
              If Cmd.Type = GET_PROBE_DATA Then
                   bln = Cmd.GetText(File_Name, 0)
                   If checker = bln Then
                        ProbeList$(ECount) = checker  [COLOR=#ff0000][B]<-- If I call out "checker" here, a msgbox shows the correct value.[/B][/COLOR]
                   End If
              End If
         Next Cmd  
    End If
    ECount = ECount + 1  [COLOR=#0000FF][B]<-- This is in the wrong location, caused my list to populate blank entries.  Moved below the "checker" assignment above, and works fine.[/B][/COLOR]
    filename = Dir ' find the Next file
Wend

MsgBox (probelist (0))  [COLOR=#ff0000][B]<-- Even here I get a blank window.  So I am missing the correct way to call out a list value.[/B][/COLOR]

'Opens Dialog For Input
Begin Dialog DIALOG_1 50,10, 225, 75,      oCalibrationSelection
'Text For Operator Input
     'Box & Text For Operator Input
         Text                5,7,85,12, "Select Stylus :"
         ListBox    57,5,100,50, ProbeList$( ), .Lstbox

'Ok And Cancel Buttons 
  OKButton       165,5,50,15
  CancelButton 165,25,50,15
 End Dialog

'Code Begins
Dim Dialg As DIALOG_1
button = Dialog(Dialg)
If Button = 0 Then Exit Sub

'Dimensions Each box Input To an assignment
Oper1 = ProbeList (Dialg.Lstbox)  [COLOR=#ff0000][B]<-- This is my problem area.  I do not know why this won't pull in my selected value from the dropdownlist.
[/B][/COLOR]
MsgBox (ProbeList(0))
MsgBox (ProbeList (1))[COLOR=#ff0000][B] <-- I tried to simulate the process and still get a blank box[/B][/COLOR]
MsgBox (Dialg.lstbox)  [COLOR=#ff0000][B]<-- This does give me the value I selected, ex. 0,1,2[/B][/COLOR]
MsgBox (Oper1)

'Begins the Variable assignment To PCDMIS For Each COMMAND
For Each Cmd In Cmds
    If Cmd.Type = ASSIGNMENT Then
         If Cmd.GetText(DEST_EXPR,0) = "PROBECHOICE" Then
         bln = Cmd.PutText("""" + Oper1 + """", SRC_EXPR, 0)  [COLOR=#ff0000][B]<-- An attempt to show the result in a variable, the variable value does not change.[/B][/COLOR]
         Cmd.ReDraw
         End If
    End If
Next Cmd

Set PartProbes = Part.Probes("RBS_HALFLEFT")  [COLOR=#ff0000][B]<-- Future use of pulled value.  If I type in the value as shown, it works.[/B][/COLOR]

'Cleanup
Set Cmd = Nothing
Set Cmds = Nothing
Set Part = Nothing
Set App = Nothing
End Sub


^Nevermind, I figured out. See blue text above.
  • Solved code 

    '  Rploughe 2015
'
Sub Main()
Dim App As Object
Dim Part As Object
Dim Cmds As Object
Dim Cmd As Object
Dim PartProbes, PartProbe, ProbeTips, ProbeTip
Dim Prober1
Dim ProbeList$()

'Creat PC-Dmis Commands
Set App = CreateObject("PCDLRN.Application")
Set Part = App.ActivePartProgram
Set Cmds = Part.Commands

serverpath = "Z:\01 Leitz PMM-Xi\probes\" 'Path coded As a network directory In "My Computer" To point To projects folder

'Assign searchpath using "serverpath"
Dim filename As String
Dim count As Integer
Dim ECount As Integer
count = 9000

'Redimension array With correct count of entries
ReDim ProbeList$(Count)

filename = Dir(serverpath & "*.*", 0) 'value of "0" pulls In all files In directory given

Let ECount = "0"

While filename <> ""
    filelength = len(filename)
    delimper = instr(1,filename,".")
    delimp = Right$(filename,(filelength-delimper))
    If delimp = "PRB" Then
         checker = Left$(filename,(filelength-4))
         For Each Cmd In Cmds
              If Cmd.Type = GET_PROBE_DATA Then
                   bln = Cmd.GetText(File_Name, 0)
                   If checker = bln Then
                        ProbeList$(ECount) = checker
                        ECount = ECount + 1
                   End If
              End If
         Next Cmd  
    End If
    filename = Dir ' find the Next file
Wend

'Opens Dialog For Input
Begin Dialog DIALOG_1 50,10, 225, 75,      oCalibrationSelection

'Text For Operator Input
     'Box & Text For Operator Input
         Text                5,7,85,12, "Select Stylus :"
         ListBox             60,5,100,20, ProbeList$( ), .Lstbox

'Ok And Cancel Buttons 
  OKButton       165,5,50,15
  CancelButton 165,25,50,15
 End Dialog

'Code Begins
Dim Dialg As DIALOG_1
button = Dialog(Dialg)
If Button = 0 Then Exit Sub

'Dimensions Each box Input To an assignment
Oper1 = ProbeList (Dialg.Lstbox)

'Cleanup
Set Cmds = Nothing
Set Part = Nothing
Set App = Nothing
End Sub
  • Hey, man! That's pretty sharp!

    What's the application?
  • ....secret.....

    When I get it finished I will post. I'm trying to automate the probe calibration based on available Stylus configurations used in a program. aka, by probe name. So far I am trying to figure out the syntax for using Qualify(), and Qualify2. As I have an analog head tip "Angles" aren't an issue for me, but I have certain stylus setups that I use often, but only 1 probe on the setup. So I am also going to try and break down the auto calibration based on each probe and the tips used in the program.

    So far the syntax has been interesting to try and follow, but I am making progress.

    This is what happens when I get bored and have free time on my hands, well when I'm not helping other people.
  • lol and if you think that is slick ^, you should poke around for some of the other things I have puzzled out from boredom.
  • When you say analog head you mean as oppose to indexing?

    Be warned: there are serious issues with the Qualify and Qualify2 methods, but this mainly relates to selecting specified tip angles, maybe with infinite angles head you might be okay, not having used one I can't comment.
  • lol and if you think that is slick ^, you should poke around for some of the other things I have puzzled out from boredom.

    I'm puzzling trying to figure out how to accomplish the same thing for some of the production machines here. I'm interested to see what you come up with!
  • NinjaBadger : Yes, I meant non-indexing.

    Rookie : I will post updates.

    Again, you can already do what I am attempting through other means. But. I would rather drop a script in and have it be mostly automated.
  • Below code is my current point.

    Neatly enough it searches through the current active program for each call of "LoadProbe/" and runs the list against what is currently in your "Probe" directory. I found that if you don't run through the commands to find the actual call out for the probe you want to "do things with" then the script would change the name of the loadprobe command prior to its insertion. (Doesn't sound that bad, but I lost some stuff. Be careful if you toy with this.) That is as far as I have gotten.

    I get to the Hierarchy of Probes. But. That is my wall. The .Qualify() command is hit and miss when executing, but the Part.Probes(Oper1) opens up the Probe Utilities dialogue. Anyone know how I can step down to gain access to the Probe (not Probes) command object members? I'm starting to get hesitant at fumbling around, like I noted, I have lost some stuff. 

     '  Rploughe 2015
 '
 Sub Main()
 Dim App As Object
 Set App = CreateObject("PCDLRN.Application")
 Dim Part As Object
 Set Part = App.ActivePartProgram
 Dim Ew As Object
 Set Ew = Part.EditWindow
 Dim Cmds As Object
 Set Cmds = Part.Commands
 Dim Cmd As Object
 Dim i As Integer
 Dim ProbeList$()

 serverpath = "Z:\01 Leitz PMM-Xi\probes\" 'Path coded As a network directory In "My Computer" To point To projects folder

 Dim filename As String
 Dim count As Integer
 Dim ECount As Integer
 count = 9000

 'Redimension array With correct count of entries
 ReDim ProbeList$(Count)

 filename = Dir(serverpath & "*.*", 0) 'value of "0" pulls In all files In directory given

 Let ECount = "0"
 While filename <> ""
     filelength = len(filename)
     delimper = instr(1,filename,".")
     delimp = Right$(filename,(filelength-delimper))
     For Each Cmd In Cmds
          If Cmd.Type = GET_PROBE_DATA Then
               If delimp = "PRB" Then
                    checker = Left$(filename,(filelength-4))
                    bln = Cmd.GetText(File_Name, 0)
                    If checker = bln Then
                         ProbeList$ (ECount) = checker
                         ECount = ECount + 1
                    End If
               End If
          End If
     Next Cmd
     filename = Dir ' find the Next file
 Wend

 'Opens Dialog For Input
 Begin Dialog DIALOG_1 50,10, 225, 75,      oCalibrationSelection
     'Text For Operator Input
     'Box & Text For Operator Input
          Text                5,7,85,12, "Select Stylus :"
          ListBox             60,5,100,50, ProbeList$( ), .Lstbox

     'Ok And Cancel Buttons 
          OKButton       165,5,50,15
          CancelButton 165,25,50,15
  End Dialog

 'Code Begins
 Dim Dialg As DIALOG_1
 button = Dialog(Dialg)
 If Button = 0 Then Exit Sub

 'Dimensions Each box Input To an assignment
 Oper1 = ProbeList (Dialg.Lstbox)

 i = 0
 For Each Cmd In Cmds
 i = i + 1
 App.StatusBar = "Cycling through commands. Current command: " & i
     If Cmd.Type = GET_PROBE_DATA And Cmd.GetText(File_Name, 0) = Oper1 Then
          If Len(Cmd.GetText(File_Name,0)) > 0 Then 
               ProbeCmd = Cmds.SetCurrentCommand(Cmds(i))
               PartProbe = Part.Probes(Oper1)
          End If
     End If
 Next Cmd

 'Cleanup
 Set App = Nothing
 Set Part = Nothing
 Set Prober = Nothing
 Set Cmds = Nothing
 End Sub
  • Sorry I misunderstood you - I thought you had an infinite indexing wrist on there - but you just have a fixed head don't you?

    But I assume there's a tool rack which can pick up different probes?

    Do you use star/T/cluster probes, or is it simply one tip per probe?
  • Yep just a fixed head with a tool rack.

    I do use star/T/things from your nightmares kinds of assemblies.

    So some probes have multiple tips.
© 2024 Hexagon AB and/or its subsidiaries. Privacy Policy | Cloud Services Agreement