hexagon logo
Register Sign in
  • Replies 4 replies
  • Subscribers 30 subscribers
  • Views 80 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 edited version for DCC ring plane:

    Sub Main

    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

    Dim PLN_ID$
    Dim X#(99), Y#(99), Z#(99)
    Dim i%, j%
    Dim HDirection%, Hpattern%, NHits%, NHitsRing%, NRings%, hit%, buttonval%
    Dim HitAngle#, HitAngleInc#, SRadius#, ERadius#, RadiusInc#
    Dim X_theo#, Y_theo#, Z_theo#, Xtheo#, Ytheo#

    Const PI = 3.141592654
    HDirection = 0
    Hpattern = 0
    NHits = 0
    NHitsRing = 0
    HitAngle = 0
    HitAngleInc = 0
    NRings = 0
    SRadius = 0
    ERadius = 0
    RadiusInc = 0

    X_theo = 0
    Y_theo = 0
    Z_theo = 0
    Xtheo = 0
    Ytheo = 0

    Begin Dialog DLG_RING_PLANE 106,15,163,177, "Ring 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 Rings"
    TextBox 2,75,35,10, .EditBox_6
    Text 45,75,55,10, "Start Diameter"
    TextBox 2,88,35,10, .EditBox_7
    Text 45,88,55,10, "End Diameter"
    TextBox 2,103,35,10, .EditBox_8
    Text 45,103,55,10, "Hits Per Ring"
    TextBox 2,118,35,10, .EditBox_9
    Text 45,118, 55,10, "Start Angle"

    GroupBox 95,1,55,45, "Hit Pattern", .GroupBox1
    GroupBox 95,75,55,45, "Hit Direction", .GroupBox2

    OptionGroup .OptionGroup1
    OptionButton 100,17,40,8, "Radial", .OptionButton1
    OptionButton 100, 28,40,8, "Orbital", .OptionButton2

    OptionGroup .OptionGroup2
    OptionButton 100, 91,40,8, "CW", .OptionButton3
    OptionButton 100, 102, 40,8, "CCW", .OptionButton4

    OKButton 30,160,44,12
    CancelButton 82,160,52,12
    End Dialog

    Dim dlg1 As DLG_RING_PLANE
    buttonval = Dialog(dlg1)

    PLN_ID = dlg1.EditBox_1
    X_theo = dlg1.EditBox_2
    Y_theo = dlg1.EditBox_3
    Z_theo = dlg1.EditBox_4
    NRings = dlg1.EditBox_5
    SRadius = dlg1.EditBox_6/2
    ERadius = dlg1.EditBox_7/2
    NHitsRing = dlg1.EditBox_8
    NHits = NRings * NHitsRing
    HitAngle = 0
    HitAngleInc = (2*PI) / NHitsRing

    If NRings > 1 Then
    RadiusInc = (ERadius - SRadius) / (NRings - 1)
    Else
    RadiusInc = 0
    End If

    If dlg1.EditBox_9 <> 0 Then
    If dlg1.EditBox_9 < 0 Then
    dlg1.EditBox_9 = 360 + dlg1.EditBox_9
    End If
    HitAngle = dlg1.EditBox_9*(PI/180)
    End If

    If dlg1.OptionGroup2 = 1 Then
    HDirection = 1
    End If

    If dlg1.OptionGroup1 = 1 Then
    Hpattern = 1
    End If

    hit = 1

    If Hpattern = 1 Then ' Orbital
    For i = 1 To NRings
    For j = 1 To NHitsRing

    If HDirection = 0 Then
    Xtheo = SRadius * cos(HitAngle) + X_theo
    Ytheo = SRadius * sin(HitAngle) + Y_theo
    Else
    Xtheo = X_theo + SRadius * cos(HitAngle)
    Ytheo = (Y_theo + SRadius * sin(HitAngle) ) * -1
    End If

    X(hit) = Xtheo
    Y(hit) = Ytheo

    hit = hit + 1
    HitAngle = HitAngle + HitAngleInc

    Next j

    HitAngle = HitAngle - HitAngleInc
    SRadius = SRadius + RadiusInc
    Next i

    Else ' If it is Not orbital it must be Radial
    For i = 1 To NHitsRing
    For j = 1 To NRings
    If HDirection = 0 Then
    Xtheo = SRadius * cos(HitAngle) + X_theo
    Ytheo = SRadius * sin(HitAngle) + Y_theo
    Else
    Xtheo = X_theo + SRadius * cos(HitAngle)
    Ytheo = (Y_theo + SRadius * sin(HitAngle)) * -1
    End If

    X(hit) = Xtheo
    Y(hit) = Ytheo
    hit = hit + 1
    SRadius = SRadius + RadiusInc

    Next j

    SRadius = SRadius - RadiusInc
    HitAngle = HitAngle - HitAngleInc
    RadiusInc = RadiusInc * -1

    Next i
    End If

    Set Cmd = Cmds.Add(CONTACT_PLANE_FEATURE, True)
    Cmd.Marked = True
    retval = Cmd.PutText (X_theo, THEO_X, 0)
    retval = Cmd.PutText (Y_theo, THEO_Y, 0)
    retval = Cmd.PutText (Z_theo, 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 (X_theo, MEAS_X, 0)
    retval = Cmd.PutText (Y_theo, MEAS_Y, 0)
    retval = Cmd.PutText (Z_theo, 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 (X_theo, TARG_X, 0)
    retval = Cmd.PutText (Y_theo, TARG_Y, 0)
    retval = Cmd.PutText (Z_theo, 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( PLN_ID, ID, 0)
    retval = Cmd.SetToggleString (1, COORD_TYPE, 0)
    retval = Cmd.SetToggleString (2, DISPLAY_TYPE,0)
    retval = Cmd.PutText(NHitsRing, N_HITS, 0)
    retval = Cmd.PutText(NRings, N_ROWS, 0)
    retval = Cmd.PutText ("DEFAULT", MEASUREMENT_STRATEGY, 0)
    'retval = Cmd.PutText ("<Current Alignment>", RMEASFEATIDX, 0) 'uncomment all if english version
    'retval = Cmd.PutText ("<Current Alignment>", RMEASFEATIDY, 0)
    'retval = Cmd.PutText ("<Current Alignment>", RMEASFEATIDZ, 0)
    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)
    'retval = Cmd.PutText ("YES", DISPLAY_HITS, 0)
    'retval = Cmd.PutText("RADIAL", PATTERN_TYPE, 0)

    For i = 1 To hit
    retval = Cmd.SetToggleString (0, HIT_TYPE, i)
    retval = Cmd.PutText (X(i), THEO_X, i)
    retval = Cmd.PutText (Y(i), THEO_Y, i)
    retval = Cmd.PutText (Z_theo, 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 (X(i), MEAS_X, i)
    retval = Cmd.PutText (Y(i), MEAS_Y, i)
    retval = Cmd.PutText (Z_theo, 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

    Set Cmd = Nothing
    Set Cmds = Nothing
    Set Part = Nothing
    Set App = Nothing

    End Sub
Reply
  • Here is my edited version for DCC ring plane:

    Sub Main

    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

    Dim PLN_ID$
    Dim X#(99), Y#(99), Z#(99)
    Dim i%, j%
    Dim HDirection%, Hpattern%, NHits%, NHitsRing%, NRings%, hit%, buttonval%
    Dim HitAngle#, HitAngleInc#, SRadius#, ERadius#, RadiusInc#
    Dim X_theo#, Y_theo#, Z_theo#, Xtheo#, Ytheo#

    Const PI = 3.141592654
    HDirection = 0
    Hpattern = 0
    NHits = 0
    NHitsRing = 0
    HitAngle = 0
    HitAngleInc = 0
    NRings = 0
    SRadius = 0
    ERadius = 0
    RadiusInc = 0

    X_theo = 0
    Y_theo = 0
    Z_theo = 0
    Xtheo = 0
    Ytheo = 0

    Begin Dialog DLG_RING_PLANE 106,15,163,177, "Ring 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 Rings"
    TextBox 2,75,35,10, .EditBox_6
    Text 45,75,55,10, "Start Diameter"
    TextBox 2,88,35,10, .EditBox_7
    Text 45,88,55,10, "End Diameter"
    TextBox 2,103,35,10, .EditBox_8
    Text 45,103,55,10, "Hits Per Ring"
    TextBox 2,118,35,10, .EditBox_9
    Text 45,118, 55,10, "Start Angle"

    GroupBox 95,1,55,45, "Hit Pattern", .GroupBox1
    GroupBox 95,75,55,45, "Hit Direction", .GroupBox2

    OptionGroup .OptionGroup1
    OptionButton 100,17,40,8, "Radial", .OptionButton1
    OptionButton 100, 28,40,8, "Orbital", .OptionButton2

    OptionGroup .OptionGroup2
    OptionButton 100, 91,40,8, "CW", .OptionButton3
    OptionButton 100, 102, 40,8, "CCW", .OptionButton4

    OKButton 30,160,44,12
    CancelButton 82,160,52,12
    End Dialog

    Dim dlg1 As DLG_RING_PLANE
    buttonval = Dialog(dlg1)

    PLN_ID = dlg1.EditBox_1
    X_theo = dlg1.EditBox_2
    Y_theo = dlg1.EditBox_3
    Z_theo = dlg1.EditBox_4
    NRings = dlg1.EditBox_5
    SRadius = dlg1.EditBox_6/2
    ERadius = dlg1.EditBox_7/2
    NHitsRing = dlg1.EditBox_8
    NHits = NRings * NHitsRing
    HitAngle = 0
    HitAngleInc = (2*PI) / NHitsRing

    If NRings > 1 Then
    RadiusInc = (ERadius - SRadius) / (NRings - 1)
    Else
    RadiusInc = 0
    End If

    If dlg1.EditBox_9 <> 0 Then
    If dlg1.EditBox_9 < 0 Then
    dlg1.EditBox_9 = 360 + dlg1.EditBox_9
    End If
    HitAngle = dlg1.EditBox_9*(PI/180)
    End If

    If dlg1.OptionGroup2 = 1 Then
    HDirection = 1
    End If

    If dlg1.OptionGroup1 = 1 Then
    Hpattern = 1
    End If

    hit = 1

    If Hpattern = 1 Then ' Orbital
    For i = 1 To NRings
    For j = 1 To NHitsRing

    If HDirection = 0 Then
    Xtheo = SRadius * cos(HitAngle) + X_theo
    Ytheo = SRadius * sin(HitAngle) + Y_theo
    Else
    Xtheo = X_theo + SRadius * cos(HitAngle)
    Ytheo = (Y_theo + SRadius * sin(HitAngle) ) * -1
    End If

    X(hit) = Xtheo
    Y(hit) = Ytheo

    hit = hit + 1
    HitAngle = HitAngle + HitAngleInc

    Next j

    HitAngle = HitAngle - HitAngleInc
    SRadius = SRadius + RadiusInc
    Next i

    Else ' If it is Not orbital it must be Radial
    For i = 1 To NHitsRing
    For j = 1 To NRings
    If HDirection = 0 Then
    Xtheo = SRadius * cos(HitAngle) + X_theo
    Ytheo = SRadius * sin(HitAngle) + Y_theo
    Else
    Xtheo = X_theo + SRadius * cos(HitAngle)
    Ytheo = (Y_theo + SRadius * sin(HitAngle)) * -1
    End If

    X(hit) = Xtheo
    Y(hit) = Ytheo
    hit = hit + 1
    SRadius = SRadius + RadiusInc

    Next j

    SRadius = SRadius - RadiusInc
    HitAngle = HitAngle - HitAngleInc
    RadiusInc = RadiusInc * -1

    Next i
    End If

    Set Cmd = Cmds.Add(CONTACT_PLANE_FEATURE, True)
    Cmd.Marked = True
    retval = Cmd.PutText (X_theo, THEO_X, 0)
    retval = Cmd.PutText (Y_theo, THEO_Y, 0)
    retval = Cmd.PutText (Z_theo, 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 (X_theo, MEAS_X, 0)
    retval = Cmd.PutText (Y_theo, MEAS_Y, 0)
    retval = Cmd.PutText (Z_theo, 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 (X_theo, TARG_X, 0)
    retval = Cmd.PutText (Y_theo, TARG_Y, 0)
    retval = Cmd.PutText (Z_theo, 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( PLN_ID, ID, 0)
    retval = Cmd.SetToggleString (1, COORD_TYPE, 0)
    retval = Cmd.SetToggleString (2, DISPLAY_TYPE,0)
    retval = Cmd.PutText(NHitsRing, N_HITS, 0)
    retval = Cmd.PutText(NRings, N_ROWS, 0)
    retval = Cmd.PutText ("DEFAULT", MEASUREMENT_STRATEGY, 0)
    'retval = Cmd.PutText ("<Current Alignment>", RMEASFEATIDX, 0) 'uncomment all if english version
    'retval = Cmd.PutText ("<Current Alignment>", RMEASFEATIDY, 0)
    'retval = Cmd.PutText ("<Current Alignment>", RMEASFEATIDZ, 0)
    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)
    'retval = Cmd.PutText ("YES", DISPLAY_HITS, 0)
    'retval = Cmd.PutText("RADIAL", PATTERN_TYPE, 0)

    For i = 1 To hit
    retval = Cmd.SetToggleString (0, HIT_TYPE, i)
    retval = Cmd.PutText (X(i), THEO_X, i)
    retval = Cmd.PutText (Y(i), THEO_Y, i)
    retval = Cmd.PutText (Z_theo, 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 (X(i), MEAS_X, i)
    retval = Cmd.PutText (Y(i), MEAS_Y, i)
    retval = Cmd.PutText (Z_theo, 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

    Set Cmd = Nothing
    Set Cmds = Nothing
    Set Part = Nothing
    Set App = Nothing

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