hexagon logo

Vector changing script?

Hey all, been lurking the forums for a few months now, finally hit a wall where the search function just doesn't cut it. I mean, I'm sure I'm not the only person to have this issue, but I guess I'm just failing at using the right search terms.
Anywho, after fighting for months with management, they finally agreed that we should be measuring our check jigs and assigned me the task. The problem with that is, most of our check jigs are for wire bending operations and are basically thin grooves cut out of MDF, so essentially 2D. Our tooling dept. has only 2D DWGs for the router path lines and nothing else. (you should see the drawings for their weld fixtures... ugh) I found out that if I try to make autofeature lines and attempt to measure a jig, it for some reason snaps the lines to the cad nominals instead of the actual measurement. I'm dead certain that there's a better way around it, but the best workaround that I've figured out is constructing lines out of vector points. It technically works, with the caveat that I have to manually change all the vectors to 0,0,1, and many jigs require over 80 vector points, and I have about 300 different jigs to measure.
So, manually doing that to every vector point takes up about 95% of the programming time for each jig, so naturally I thought, "hey, I'm not too bad at VBA, I'm sure I could figure out a script to do it for me." Oh, how wrong I was...
After a couple days of tinkering, I finally figured out how to actually select a command and change its vector values, so far so good. Now, let's try to make a loop for a given range of points, aaaannd.... I can't understand exactly why or how to circumvent it, but when I try to select the next command, or at least I falsely think I am, it changes the name of the current command instead!

Is there any way that I can loop through a group of features to change their vectors with script, or is there a better way that I just don't know about?

Hopefully the code isn't too sloppy to read, I've been just randomly throwing code at the problem at this point.

Sub Main()

Dim PCDapp As pcdlrn.Application
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
Set Cmd = Cmds.Item

Ew.Visible = True

Dim feattype As String
Dim FirstFeature, LastFeature As Integer
feattype = ("pnt")
FirstFeature = 8
LastFeature = 18
'FeatType = InputBox("Enter feature type:")
'FirstFeature = InputBox("type in first feature number:")
'LastFeature = InputBox("type in last feature number:")

Dim StartCmd As Object
Set StartCmd = Cmds.Item(feattype & FirstFeature)

Dim EndCmd As Object
Set EndCmd = Cmds.Item(feattype & LastFeature)

Dim FeatList As Long
FeatList = LastFeature - FirstFeature

Dim coll As Collection
Set coll = New Collection

Dim i As Integer
For i = 1 To FeatList
coll.Add StartCmd.ID
FirstFeature = FirstFeature + 1
StartCmd = feattype & FirstFeature
Next

For i = 1 To coll.count
Cmds.SetCurrentCommand coll(i)
Set Cmd = coll(i)
Ew.SelectCommand

If Cmd.ID = StartCmd And Cmd.ID <> EndCmd Then
retval = Cmd.PutText("0", THEO_I, 0)
retval = Cmd.PutText("0", THEO_J, 0)
retval = Cmd.PutText("1", THEO_K, 0)
Ew.UnselectAll
End If
Next

End Sub


Thanks in advance!
  • What is the source or origination for the vector points with the vectors you need to change?
  • So you're just taking hits in the z direction on the bottom of the groove, to check the shape of the groove?
  • Ninja: essentially, yes. Most of the grooves are less than 1/4", so it's just easier to follow the centerline with a 6mm ruby rather than trying to use something smaller to measure lines.

    edit: actually, it's not technically the bottom of the grooves, more like measuring a circle with one hit.

    Kneislyd: I'm not 100% sure what you're asking, but I think the answer is that I'm basically using an imported 2d dwg and making auto vector points by clicking on the lines and then adjusting the vectors. Yes, it's about as backward as it sounds..
  • good Day,

    1.) I shortened your script a bit.
    why ? well pcDMIS script engine doesn't like subfunctions, object arrays or Collection
    (if you want to run the script directly in pcdmis, rather not use fancy things)

    2.) You don't need "Edit Window" for this task.

    3.) I have to join the others, not sure what you're trying to achieve, so can't say if there's an easier way.

    4.) the script only works if pcdmis is not running a program, otherwise it will self-destruct

    Sub Main()
    ' Dim something ---------------------------
    Dim App As Object
    Set App = CreateObject("PCDLRN.Application")
    Dim Part As Object
    Set Part = App.ActivePartProgram
    Dim Cmds As Object
    Set Cmds = Part.Commands
    Dim Cmd As Object
    Set Cmd = Nothing
    
    Dim feattype As String
    Dim CountFeature, FirstFeature, LastFeature As Integer
    
    
    ' set names --------------------------------
    feattype = "PNT" 'pay attention to upper case and lower case
    FirstFeature = 1
    LastFeature = 10
    'FeatType = uppercase(InputBox("Enter feature type:"))
    'FirstFeature = InputBox("type in first feature number:")
    'LastFeature = InputBox("type in last feature number:")
    
    
    ' search Commands to change ---------------------------
    CountFeature = 0
    For Each Cmd In Cmds
    If Cmd.ID = feattype & CStr(FirstFeature + CountFeature) Then
      ' found Feature
      CountFeature = CountFeature + 1
    
      Cmd.Marked = True
      RetVal = Cmd.PutText("0", THEO_I, 0) 'set nominal
      RetVal = Cmd.PutText("0", THEO_J, 0) 'set nominal
      RetVal = Cmd.PutText("1", THEO_K, 0) 'set nominal
    
      'RetVal = Cmd.PutText("0", MEAS_I, 0) 'deletes old measured
      'RetVal = Cmd.PutText("0", MEAS_J, 0) 'deletes old measured
      'RetVal = Cmd.PutText("1", MEAS_K, 0) 'deletes old measured
    
      RetVal = Cmd.PutText("0", TARG_I, 0) 'set target
      RetVal = Cmd.PutText("0", TARG_J, 0) 'set target
      RetVal = Cmd.PutText("1", TARG_K, 0) 'set target
    End If
    If CountFeature >= LastFeature Then Exit For
    Next Cmd
    
    ' done ---------------------------
    Part.RefreshPart
    
    
    ' unDim something ---------------------------
    Set Cmd = Nothing
    Set Cmds = Nothing
    Set Part = Nothing
    Set App = Nothing
    End Sub
    
  • Wow, I was definitely overthinking this one, that did almost exactly what I was trying to do. Thank you! I obviously need to spend more time learning how the pc dmis language actually works, it certainly isn't as intuitive for me as VBA or VB.Net.

    As for what I'm actually trying to do, I'm trying to measure the angles and intersection lengths of a 2D object. Our jigs are made of MDF, and they warp way more than production thinks, so I'm essentially trying to prove the point that we need to stop relying on them for our audits and inspections and that we shouldn't just trust tooling dept.'s word as to wether it's correct or not. I've already scrapped a couple dozen jigs that were supposedly "just fine". The jigs are simply grooves cut in a board with a cnc router, we put the bent part in the groove to confirm that it's the right size and shape. If I try to use auto features and select the router path lines on the 2D DWG, every time I measure a jig it snaps to the "model" and the measured values are always nominal, or if I type in the auto features the probe doesn't compensate properly if I reference the top plane of the jig. So that's why I'm using just straight up vector points and constructing lines with them, it's the only way I've figured out that actually reliably gives me an accurate measurement, based on a circle/diamond/square that I had tooling cut for me that I also physically measured by hand. Up until trying your code, some jigs took over a couple hours to program a measurement routine.

    I did have to change the uppercase to UCase, otherwise the only thing it needs now is a check for if a feature actually exists so it doesn't lag behind the feature count. Otherwise I'm gonna have to be extra careful from now on not to delete any features before modifying the vectors. Does the Dmis library have an IfExists function? I can't find one specifically for commands.
  • good Day,

    yes, I see what you mean.

    Unfortunately, this functionality does not exist in the pcDMIS-scripting language.
    This means that if you want to use something like this, the script only works with external programs.
    (please be aware that if you use an external program you have almost no restrictions)

    But there is an alternative:

    you have to mark the used points somehow, no matter what name they have.
    1.) The quickest way is to put the points in a pcDMIS-group, the script can then capture all the points that are in the group.
    2.) or you mark the points to be edited with F3 and tell the script to modify all Point-commands that also marked

    ah yes, a script can also get the name of the comand where your cursor is right now.
    and you can also assign an icon to the script and, above all, a hotkey.
    With this you can, for example, simply place your cursor over the pcDMIS group and then press the hotkey.
    maybe thats handy.

    i can help you with the code if you want
  • Using groups makes total sense, I typically group them just to clean up the interface anyways. I'll try and see if I can work out how to go about doing it and I can post my results. I tend to prefer trying to understand the process first vs simply knowing how to do it.
    So I basically have to use a for/next loop on a selected group, and have it go through all featcmd's with a point value?
    Thanks for the suggestions so far!
  • Yup, I think that's the way to go. It worked perfectly, I just have to unmark everything, then mark the group and hit the go button. Much simpler code too. Now to make a user defined button for it and I'll be set.

    Sub Mod_Vector()
    
    Dim App As Object
    Set App = CreateObject("PCDLRN.Application")
    Dim Part As Object
    Set Part = App.ActivePartProgram
    Dim Cmds As Object
    Set Cmds = Part.Commands
    Dim Cmd As Object
    Set Cmd = Nothing
    
    ' search Commands to change ---------------------------
    
    For Each Cmd In Cmds
    If Cmd.Marked = True Then
    If Cmd.Feature = 1 Then
    retval = Cmd.PutText("0", THEO_I, 0) 'set nominal
    retval = Cmd.PutText("0", THEO_J, 0) 'set nominal
    retval = Cmd.PutText("1", THEO_K, 0) 'set nominal
    
    retval = Cmd.PutText("0", MEAS_I, 0) 'deletes old measured
    retval = Cmd.PutText("0", MEAS_J, 0) 'deletes old measured
    retval = Cmd.PutText("1", MEAS_K, 0) 'deletes old measured
    
    retval = Cmd.PutText("0", TARG_I, 0) 'set target
    retval = Cmd.PutText("0", TARG_J, 0) 'set target
    retval = Cmd.PutText("1", TARG_K, 0) 'set target
    End If
    End If
    Next Cmd
    
    ' done ---------------------------
    Part.RefreshPart
    
    
    ' unDim something ---------------------------
    Set Cmd = Nothing
    Set Cmds = Nothing
    Set Part = Nothing
    Set App = Nothing
    
    End Sub
  • if you do groups anyway, the 1st variant i suggested is a bit shorter in handling. But anyway, that work too Slight smile
    glad you were able to solve your problem
  • I tried the first variant, and either I am going about it wrong, (most likely the case) or it doesn't recognize a group as a command. The current script does work, but if you know how to loop through a group instead of the whole program, I'd be glad to try it out.