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
  • 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
Reply
  • 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
Children