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!
Parents
  • 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
    
Reply
  • 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
    
Children
No Data