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

Ring Plane Basic Script

Moolvie
Here is a script I just wrote to create a ring plane it can do 1 or more rings starting and ending at specified diameters
Attached Files
Parents
  • Fixed Bugs with direction when x and y are not zero, and feature theo x y values are not updated

    Sub Main

    Dim PCDapp As Object
    Dim PCDpart As Object
    Dim Cmds As Object
    Dim Cmd As Object
    Dim FCmd As Object

    Dim Lenght#, Width#
    Dim Rows%, RowHits%, NumHits%, hit%
    Dim tX#, tY#, tZ#, theo_X#, theo_Y#
    Dim theoX#(99), theoY#(99)
    Dim PlnID$, Direction$(3)
    Dim ButtonVal%, PattLenght#, PattWidth#
    Dim pdirection%, wdirection%, start_X#, start_Y#

    Set PCDapp = CreateObject("PCDLRN.Application")
    Set PCDpart = PCDapp.ActivePartProgram
    Set Cmds = PCDpart.Commands

    Direction(0) = "XPLUS"
    Direction(1) = "YPLUS"
    Direction(2) = "XMINUS"
    Direction(3) = "YMINUS"

    Begin Dialog DLG_PATTERN_PLANE 106,15,163,177, "Pattern Plane"
    TextBox 2, 1,40,10, .EditBox_1
    Text 45,1,55,10, "PLN ID"
    TextBox 2,14,35,10, .EditBox_2
    Text 45,14,55,10, "X Origin"
    TextBox 2,27,35,10, .EditBox_3
    Text 45,27,55,10, "Y Origin"
    TextBox 2,40,35,10, .EditBox_4
    Text 45,40,55,10, "Z Origin"
    TextBox 2,53,35,10, .EditBox_5
    Text 45,53,55,10, "Number of Rows"
    TextBox 2,75,35,10, .EditBox_6
    Text 45,75,55,10, "Lenght"
    TextBox 2,88,35,10, .EditBox_7
    Text 45,88,55,10, "Width"
    TextBox 2,103,35,10, .EditBox_8
    Text 45,103,55,10, "Hits Per Row"
    DropListBox 100,17,40,8, Direction$(), .dirListbox
    OKButton 30,160,44,12
    CancelButton 82,160,52,12
    End Dialog

    Dim dlg1 As DLG_PATTERN_PLANE

    dlg1.EditBox_1 = "PLN"
    dlg1.EditBox_2 = 0
    dlg1.EditBox_3 = 0
    dlg1.EditBox_4 = 0

    ButtonVal = Dialog(dlg1)

    PlnID = dlg1.EditBox_1
    tX = dlg1.EditBox_2
    tY = dlg1.EditBox_3
    tZ = dlg1.EditBox_4
    RowHits = dlg1.EditBox_8
    Rows = dlg1.EditBox_5
    Lenght = dlg1.EditBox_6
    Width = dlg1.EditBox_7
    NumHits = Rows * RowHits
    PattLenght = Lenght/(RowHits - 1)
    PattWidth = Width/(Rows - 1)
    hit = 1

    pdirection = 0
    wdirection = 0

    If dlg1.dirListbox = 0 Or dlg1.dirListbox = 2 Then
    pdirection = 1
    ElseIf dlg1.dirListbox = 1 Or dlg1.dirListbox = 3 Then
    wdirection = 1
    End If

    If pdirection = 1 Then
    If dlg1.dirListbox = 0 Then
    start_X = tX + (Lenght/2)
    start_Y = tY + (Width/2)
    PattLenght = PattLenght * -1
    PattWidth = PattWidth * -1
    ElseIf dlg1.dirListbox = 2 Then
    start_X = (tX - (Lenght/2))
    start_Y = (tY - (Width/2))
    End If
    Else
    If dlg1.dirListbox = 1 Then
    start_X = tX - (Width/2)
    start_Y = tY + (Lenght/2)
    PattLenght = PattLenght * -1
    ElseIf dlg1.dirListbox = 3 Then
    start_X = (tX + (Width/2))
    start_Y = (tY - (Lenght/2))
    PattWidth = PattWidth * -1
    End If
    End If

    theo_X = start_X
    theo_Y = start_Y

    If pdirection = 1 Then
    For i = 1 To Rows
    For h = 1 To RowHits
    theoX(hit) = theo_X
    theoY(hit) = theo_Y
    hit = hit + 1
    If h < RowHits Then
    theo_X = theo_X + PattLenght
    End If

    Next h
    theo_Y = theo_Y + PattWidth
    PattLenght = PattLenght * -1
    Next i
    ElseIf wdirection = 1 Then
    For i = 1 To Rows
    For h = 1 To RowHits
    theoX(hit) = theo_X
    theoY(hit) = theo_Y
    hit = hit + 1
    If h < RowHits Then
    theo_Y = theo_Y + PattLenght
    End If

    Next h
    theo_X = theo_X + PattWidth
    PattLenght = PattLenght * -1
    Next i
    End If

    If ButtonVal = -1 Then

    Set Cmd = Cmds.CurrentCommand
    Cmds.InsertionPointAfter Cmd

    Set Cmd = Cmds.Add(CONTACT_PLANE_FEATURE, True)
    Cmd.Marked = True
    retval = Cmd.PutText (tX, THEO_X, 0)
    retval = Cmd.PutText (tY, THEO_Y, 0)
    retval = Cmd.PutText (tZ, THEO_Z, 0)
    retval = Cmd.PutText ("0", THEO_I, 0)
    retval = Cmd.PutText ("0", THEO_J, 0)
    retval = Cmd.PutText ("1", THEO_K, 0)
    retval = Cmd.PutText ("0", ANGVEC_I, 0)
    retval = Cmd.PutText ("1", ANGVEC_J, 0)
    retval = Cmd.PutText ("0", ANGVEC_K, 0)
    retval = Cmd.PutText (tX, MEAS_X, 0)
    retval = Cmd.PutText (tY, MEAS_Y, 0)
    retval = Cmd.PutText (tZ, MEAS_Z, 0)
    retval = Cmd.PutText ("0", MEAS_I, 0)
    retval = Cmd.PutText ("0", MEAS_J, 0)
    retval = Cmd.PutText ("1", MEAS_K, 0)
    retval = Cmd.PutText (tX, TARG_X, 0)
    retval = Cmd.PutText (tY, TARG_Y, 0)
    retval = Cmd.PutText (tZ, TARG_Z, 0)
    retval = Cmd.PutText ("0", TARG_I, 0)
    retval = Cmd.PutText ("0", TARG_J, 0)
    retval = Cmd.PutText ("1", TARG_K, 0)
    retval = Cmd.PutText ("1", REPORTVEC_I, 0)
    retval = Cmd.PutText ("0", REPORTVEC_J, 0)
    retval = Cmd.PutText ("0", REPORTVEC_K, 0)
    retval = Cmd.PutText(PlnID, ID, 0)
    retval = Cmd.SetToggleString (1, COORD_TYPE, 0)
    retval = Cmd.SetToggleString (2, DISPLAY_TYPE,0)
    retval = Cmd.PutText(RowHits, N_HITS, 0)
    retval = Cmd.PutText(Rows, N_ROWS, 0)
    If PattLenght > 0 Then
    retval = Cmd.PutText(PattLenght, F_SPACER, 0)
    Else
    retval = Cmd.PutText((PattLenght * -1), F_SPACER, 0)
    End If
    retval = Cmd.SetToggleString (1, BF_MATH_TYPE, 0)
    retval = Cmd.SetToggleString (3, FIND_NOMS_TYPE, 0)
    retval = Cmd.SetToggleString (3, THICKNESS_TYPE, 0)
    retval = Cmd.PutText ("0", F_THICKNESS, 0)
    retval = Cmd.SetToggleString (2, DISPLAY_PROBE_PARAMETERS, 0)
    retval = Cmd.SetToggleString (2, DISPLAY_ADVANCED_PARAMETERS, 0)

    For i = 1 To hit
    retval = Cmd.SetToggleString (0, HIT_TYPE, i)
    retval = Cmd.PutText (theoX(i), THEO_X, i)
    retval = Cmd.PutText (theoY(i), THEO_Y, i)
    retval = Cmd.PutText (tZ, THEO_Z, i)
    retval = Cmd.PutText ("0", THEO_I, i)
    retval = Cmd.PutText ("0", THEO_J, i)
    retval = Cmd.PutText ("1", THEO_K, i)
    retval = Cmd.PutText (theoX(i), MEAS_X, i)
    retval = Cmd.PutText (theoY(i), MEAS_Y, i)
    retval = Cmd.PutText (tZ, MEAS_Z, i)
    retval = Cmd.PutText ("0", MEAS_I, i)
    retval = Cmd.PutText ("0", MEAS_J, i)
    retval = Cmd.PutText ("1", MEAS_K, i)
    Next i

    Set FCmd = Cmd.FeatureCommand

    FCmd.PutPoint FHITDATA_CENTROID, FDATA_THEO, tX, tY, tZ

    For i = 1 To hit
    retval = FCmd.SetHit (i, FHITDATA_CENTROID, FDATA_THEO, theoX(i), theoY(i), tZ)
    Next i

    Cmd.Redraw
    PCDpart.RefreshPart

    End If

    Set Cmd = Nothing
    Set Cmds = Nothing
    Set FCmd = Nothing
    Set PCDpart = Nothing
    Set PCDapp = Nothing

    End Sub
Reply
  • Fixed Bugs with direction when x and y are not zero, and feature theo x y values are not updated

    Sub Main

    Dim PCDapp As Object
    Dim PCDpart As Object
    Dim Cmds As Object
    Dim Cmd As Object
    Dim FCmd As Object

    Dim Lenght#, Width#
    Dim Rows%, RowHits%, NumHits%, hit%
    Dim tX#, tY#, tZ#, theo_X#, theo_Y#
    Dim theoX#(99), theoY#(99)
    Dim PlnID$, Direction$(3)
    Dim ButtonVal%, PattLenght#, PattWidth#
    Dim pdirection%, wdirection%, start_X#, start_Y#

    Set PCDapp = CreateObject("PCDLRN.Application")
    Set PCDpart = PCDapp.ActivePartProgram
    Set Cmds = PCDpart.Commands

    Direction(0) = "XPLUS"
    Direction(1) = "YPLUS"
    Direction(2) = "XMINUS"
    Direction(3) = "YMINUS"

    Begin Dialog DLG_PATTERN_PLANE 106,15,163,177, "Pattern Plane"
    TextBox 2, 1,40,10, .EditBox_1
    Text 45,1,55,10, "PLN ID"
    TextBox 2,14,35,10, .EditBox_2
    Text 45,14,55,10, "X Origin"
    TextBox 2,27,35,10, .EditBox_3
    Text 45,27,55,10, "Y Origin"
    TextBox 2,40,35,10, .EditBox_4
    Text 45,40,55,10, "Z Origin"
    TextBox 2,53,35,10, .EditBox_5
    Text 45,53,55,10, "Number of Rows"
    TextBox 2,75,35,10, .EditBox_6
    Text 45,75,55,10, "Lenght"
    TextBox 2,88,35,10, .EditBox_7
    Text 45,88,55,10, "Width"
    TextBox 2,103,35,10, .EditBox_8
    Text 45,103,55,10, "Hits Per Row"
    DropListBox 100,17,40,8, Direction$(), .dirListbox
    OKButton 30,160,44,12
    CancelButton 82,160,52,12
    End Dialog

    Dim dlg1 As DLG_PATTERN_PLANE

    dlg1.EditBox_1 = "PLN"
    dlg1.EditBox_2 = 0
    dlg1.EditBox_3 = 0
    dlg1.EditBox_4 = 0

    ButtonVal = Dialog(dlg1)

    PlnID = dlg1.EditBox_1
    tX = dlg1.EditBox_2
    tY = dlg1.EditBox_3
    tZ = dlg1.EditBox_4
    RowHits = dlg1.EditBox_8
    Rows = dlg1.EditBox_5
    Lenght = dlg1.EditBox_6
    Width = dlg1.EditBox_7
    NumHits = Rows * RowHits
    PattLenght = Lenght/(RowHits - 1)
    PattWidth = Width/(Rows - 1)
    hit = 1

    pdirection = 0
    wdirection = 0

    If dlg1.dirListbox = 0 Or dlg1.dirListbox = 2 Then
    pdirection = 1
    ElseIf dlg1.dirListbox = 1 Or dlg1.dirListbox = 3 Then
    wdirection = 1
    End If

    If pdirection = 1 Then
    If dlg1.dirListbox = 0 Then
    start_X = tX + (Lenght/2)
    start_Y = tY + (Width/2)
    PattLenght = PattLenght * -1
    PattWidth = PattWidth * -1
    ElseIf dlg1.dirListbox = 2 Then
    start_X = (tX - (Lenght/2))
    start_Y = (tY - (Width/2))
    End If
    Else
    If dlg1.dirListbox = 1 Then
    start_X = tX - (Width/2)
    start_Y = tY + (Lenght/2)
    PattLenght = PattLenght * -1
    ElseIf dlg1.dirListbox = 3 Then
    start_X = (tX + (Width/2))
    start_Y = (tY - (Lenght/2))
    PattWidth = PattWidth * -1
    End If
    End If

    theo_X = start_X
    theo_Y = start_Y

    If pdirection = 1 Then
    For i = 1 To Rows
    For h = 1 To RowHits
    theoX(hit) = theo_X
    theoY(hit) = theo_Y
    hit = hit + 1
    If h < RowHits Then
    theo_X = theo_X + PattLenght
    End If

    Next h
    theo_Y = theo_Y + PattWidth
    PattLenght = PattLenght * -1
    Next i
    ElseIf wdirection = 1 Then
    For i = 1 To Rows
    For h = 1 To RowHits
    theoX(hit) = theo_X
    theoY(hit) = theo_Y
    hit = hit + 1
    If h < RowHits Then
    theo_Y = theo_Y + PattLenght
    End If

    Next h
    theo_X = theo_X + PattWidth
    PattLenght = PattLenght * -1
    Next i
    End If

    If ButtonVal = -1 Then

    Set Cmd = Cmds.CurrentCommand
    Cmds.InsertionPointAfter Cmd

    Set Cmd = Cmds.Add(CONTACT_PLANE_FEATURE, True)
    Cmd.Marked = True
    retval = Cmd.PutText (tX, THEO_X, 0)
    retval = Cmd.PutText (tY, THEO_Y, 0)
    retval = Cmd.PutText (tZ, THEO_Z, 0)
    retval = Cmd.PutText ("0", THEO_I, 0)
    retval = Cmd.PutText ("0", THEO_J, 0)
    retval = Cmd.PutText ("1", THEO_K, 0)
    retval = Cmd.PutText ("0", ANGVEC_I, 0)
    retval = Cmd.PutText ("1", ANGVEC_J, 0)
    retval = Cmd.PutText ("0", ANGVEC_K, 0)
    retval = Cmd.PutText (tX, MEAS_X, 0)
    retval = Cmd.PutText (tY, MEAS_Y, 0)
    retval = Cmd.PutText (tZ, MEAS_Z, 0)
    retval = Cmd.PutText ("0", MEAS_I, 0)
    retval = Cmd.PutText ("0", MEAS_J, 0)
    retval = Cmd.PutText ("1", MEAS_K, 0)
    retval = Cmd.PutText (tX, TARG_X, 0)
    retval = Cmd.PutText (tY, TARG_Y, 0)
    retval = Cmd.PutText (tZ, TARG_Z, 0)
    retval = Cmd.PutText ("0", TARG_I, 0)
    retval = Cmd.PutText ("0", TARG_J, 0)
    retval = Cmd.PutText ("1", TARG_K, 0)
    retval = Cmd.PutText ("1", REPORTVEC_I, 0)
    retval = Cmd.PutText ("0", REPORTVEC_J, 0)
    retval = Cmd.PutText ("0", REPORTVEC_K, 0)
    retval = Cmd.PutText(PlnID, ID, 0)
    retval = Cmd.SetToggleString (1, COORD_TYPE, 0)
    retval = Cmd.SetToggleString (2, DISPLAY_TYPE,0)
    retval = Cmd.PutText(RowHits, N_HITS, 0)
    retval = Cmd.PutText(Rows, N_ROWS, 0)
    If PattLenght > 0 Then
    retval = Cmd.PutText(PattLenght, F_SPACER, 0)
    Else
    retval = Cmd.PutText((PattLenght * -1), F_SPACER, 0)
    End If
    retval = Cmd.SetToggleString (1, BF_MATH_TYPE, 0)
    retval = Cmd.SetToggleString (3, FIND_NOMS_TYPE, 0)
    retval = Cmd.SetToggleString (3, THICKNESS_TYPE, 0)
    retval = Cmd.PutText ("0", F_THICKNESS, 0)
    retval = Cmd.SetToggleString (2, DISPLAY_PROBE_PARAMETERS, 0)
    retval = Cmd.SetToggleString (2, DISPLAY_ADVANCED_PARAMETERS, 0)

    For i = 1 To hit
    retval = Cmd.SetToggleString (0, HIT_TYPE, i)
    retval = Cmd.PutText (theoX(i), THEO_X, i)
    retval = Cmd.PutText (theoY(i), THEO_Y, i)
    retval = Cmd.PutText (tZ, THEO_Z, i)
    retval = Cmd.PutText ("0", THEO_I, i)
    retval = Cmd.PutText ("0", THEO_J, i)
    retval = Cmd.PutText ("1", THEO_K, i)
    retval = Cmd.PutText (theoX(i), MEAS_X, i)
    retval = Cmd.PutText (theoY(i), MEAS_Y, i)
    retval = Cmd.PutText (tZ, MEAS_Z, i)
    retval = Cmd.PutText ("0", MEAS_I, i)
    retval = Cmd.PutText ("0", MEAS_J, i)
    retval = Cmd.PutText ("1", MEAS_K, i)
    Next i

    Set FCmd = Cmd.FeatureCommand

    FCmd.PutPoint FHITDATA_CENTROID, FDATA_THEO, tX, tY, tZ

    For i = 1 To hit
    retval = FCmd.SetHit (i, FHITDATA_CENTROID, FDATA_THEO, theoX(i), theoY(i), tZ)
    Next i

    Cmd.Redraw
    PCDpart.RefreshPart

    End If

    Set Cmd = Nothing
    Set Cmds = Nothing
    Set FCmd = Nothing
    Set PCDpart = Nothing
    Set PCDapp = Nothing

    End Sub
Children
No Data
© 2024 Hexagon AB and/or its subsidiaries. Privacy Policy | Cloud Services Agreement