hexagon logo
Register Sign in
  • Replies 4 replies
  • Subscribers 30 subscribers
  • Views 81 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
  • Here is my script to make DCC pattern plane.


    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)

    If ButtonVal = -1 Then

    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)) * -1
    start_Y = (tY + (Width/2)) * -1
    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)) * -1
    start_Y = (tY + (Lenght/2)) * -1
    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

    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

    Cmd.Redraw
    PCDpart.RefreshPart

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


    Cmd.Redraw

    End If

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

    End Sub
Reply
  • Here is my script to make DCC pattern plane.


    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)

    If ButtonVal = -1 Then

    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)) * -1
    start_Y = (tY + (Width/2)) * -1
    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)) * -1
    start_Y = (tY + (Lenght/2)) * -1
    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

    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

    Cmd.Redraw
    PCDpart.RefreshPart

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


    Cmd.Redraw

    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