Rename features to numerical order

I was wondering if there was a way to rename features after all features have been created. I like to write my offline programs using individual Auto Vector Points and then I will build features like planes and lines (for example) after everything is created. A common problem I run into is I'll forget to put a point into a certain location. So I'll go back and insert a point where I want but since I've created 30 points after this location the new point I create will not be in numerical order. Is there a way I can tell PC-DMIS to rename all points to numerical order? Hope this makes sense. I've attached a screen shot as an example.

Attached Files

text example.docx

Parents

jnjbeaud over 5 years ago

Dim PCDApp As Object
Dim PCDPartPrograms As Object
Dim PCDPartProgram As Object
Dim PCDCommands As Object
Dim PCDCommand As Object
Dim Fcntr,Vcntr As Integer
Dim FeatureList$(1000)
Dim VariableList$(1000)
Dim fType,vValue,dValue As String

Sub Part1

Set PCDApp = CreateObject("PCDLRN.Application")
Set PCDPartPrograms = PCDApp.PartPrograms
Set PCDPartProgram = PCDApp.ActivePartProgram
Set PCDCommands = PCDPartProgram.Commands

Dim MyList$ (16)
MyList (0) =612
MyList (1) =615
MyList (2) =616
MyList (3) =614
MyList (4) =617
MyList (5) =618
MyList (6) =605
MyList (7) =619
MyList (8) =613
MyList (9) =602
MyList (10) =596
MyList (11) =544
MyList (12) =586
MyList (13) =587
MyList (14) =241
MyList (15) =245
MyList (16) =243

Begin Dialog DIALOGNAME1 48,60, 199, 195, "Select"
ComboBox 10,14,24,150, MyList$(), .Combo1
CancelButton 142,172,40,12
OKButton 14,172,40,12
Text 40,28,121,12, "CONTACT_CIRCLE_FEATURE"
Text 40,36,121,12, "CONTACT_CONE_FEATURE"
Text 40,44,121,12, "CONTACT_CYLINDER_FEATURE"
Text 40,52,121,12, "CONTACT_LINE_FEATURE"
Text 40,60,121,12, "CONTACT_PLANE_FEATURE"
Text 40,68,121,12, "CONTACT_SLOT_ROUND_FEATURE"
Text 40,76,121,12, "CONTACT_ANGLE_POINT_FEATURE"
Text 40,84,121,12, "CONTACT_SLOT_SQUARE_FEATURE"
Text 40,92,121,12, "CONTACT_SPHERE_FEATURE"
Text 40,100,121,12, "CONTACT_VECTOR_POINT_FEATURE"
Text 40,108,121,12, "CONST_SET"
Text 40,116,121,12, "CONST_MID_LINE"
Text 40,124,121,12, "CONST_WIDTH2D_FEATURE"
Text 40,132,121,12, "CONST_WIDTH3D_FEATURE"
Text 40,140,121,12, "VISION_SURFACE_POINT_FEATURE"
Text 40,148,121,12, "VISION_CIRCLE_FEATURE"
Text 40,156,121,12, "VISION_LINE_FEATURE"
End Dialog

Dim Dlg1 As DialogName1
Dlg1.Combo1 = "Selection"
button = Dialog( Dlg1 )
If button = 2 Then
Quit
End If

Dim fType As String

PntName = "POINT"
LineName = "AUTOLINE"
CircleName = "AUTOCIRCLE"
RdSlotName = "ROUNDSLOT"
SqSlotName = "SQUARESLOT"
WidthName = "WIDTH"
PlaneName = "AUTOPLANE"
AngleName = "ANGLEPNT"
CylinderName = "AUTOCYLINDER"
ConeName = "AUTOCONE"
SphereName = "AUTOSPHERE"
SetName = "FEATURESET"
MidLineName = "MIDLINE"
VisionPointName = "VISIONPOINT"
VisionCircleName = "VISIONCIRCLE"
VisionLineName = "VISIONLINE"

Select Case Dlg1.Combo1
Case 612
fType = CircleName
Case 615
fType = ConeName
Case 616
fType = CylinderName
Case 614
fType = LineName
Case 617
fType = PlaneName
Case 618
fType = SlotName
Case 605
fType = AngleName
Case 619
fType = SqSlotName
Case 613
fType = SphereName
Case 602
fType = PntName
Case 596
fType = SetName
Case 544
fType = MidLineName
Case 586
fType = WidthName
Case 587
fType = WidthName
Case 241
fType = VisionPointName
Case 245
fType = VisionCircleName
Case 243
fType = VisionCircleName
End Select

Dim aArray$(46) As Integer
aArray(0) = "STARTZ"
aArray(1) = "STARTX"
aArray(2) = "STARTY"
aArray(3) = "STARTXY"
aArray(4) = "PNT1"
aArray(5) = "PNT2"
aArray(6) = "PNT3"
aArray(7) = "PNT4"
aArray(8) = "PNT5"
aArray(9) = "PNT6"
aArray(10) = "PNT7"
aArray(11) = "A1"
aArray(12) = "A2"
aArray(13) = "A3"
aArray(14) = "A4"
aArray(15) = "B1"
aArray(16) = "B2"
aArray(17) = "B3"
aArray(18) = "B4"
aArray(19) = "C1"
aArray(20) = "C2"
aArray(21) = "C3"
aArray(22) = "C4"
aArray(23) = "C5"
aArray(24) = "C6"
aArray(25) = "C7"
aArray(26) = "C8"
aArray(27) = "C9"
aArray(28) = "C10"
aArray(29) = "C11"
aArray(30) = "C12"
aArray(31) = "DATUMA"
aArray(32) = "DATUMB"
aArray(33) = "DATUMC"
aArray(34) = "DATUMD"
aArray(35) = "DATUME"
aArray(36) = "DATUMF"
aArray(37) = "DATUMG"
aArray(38) = "ITERATE1"
aArray(39) = "ITERATE2"
aArray(40) = "ITERATE3"
aArray(41) = "ITERATE4"
aArray(42) = "ITERATE5"
aArray(43) = "ITERATE6"
aArray(44) = "ITERATE7"
aArray(45) = "ROTATE"

For Each PCDCommand In PCDCommands
If PCDCommand.Type = Dlg1.Combo1 Then
vValue = PCDCommand.ID
vType = PCDCommand.Type

For i = 0 To 45
If aArray(i) = vValue Then
GoTo Label1
End If
Next i

FeatureList(Fcntr) = PCDCommand.ID
Fcntr = Fcntr + 1
retval = PCDCommand.PutText (fType & Fcntr, ID, 0)

If Dlg1.Combo1 = 195 Then
dValue = PCDCommand.GetText(133,1)

Select Case dValue
Case dValue = "READX"
GoTo Label1
Case dValue = "READY"
GoTo Label1
Case dValue = "READZ"
GoTo Label1
Case dValue = "ZSTART"
GoTo Label1
Case dValue = "SAMPELNUM"
GoTo Label1
Case dValue = "DATA"
GoTo Label1
End Select

VariableList(Vcntr ) = fType
Vcntr = Vcntr + 1
retval = PCDCommand.PutText (fType & Vcntr , DEST_EXPR, 0)
End If

Label1:
End If

Next PCDCommand

End Sub

Sub Main
Part1
PCDPartProgram.RefreshPart
End Sub
Cancel
Vote Up 0 Vote Down

Sign in to reply

Cancel

Reply

jnjbeaud over 5 years ago

Dim PCDApp As Object
Dim PCDPartPrograms As Object
Dim PCDPartProgram As Object
Dim PCDCommands As Object
Dim PCDCommand As Object
Dim Fcntr,Vcntr As Integer
Dim FeatureList$(1000)
Dim VariableList$(1000)
Dim fType,vValue,dValue As String

Sub Part1

Set PCDApp = CreateObject("PCDLRN.Application")
Set PCDPartPrograms = PCDApp.PartPrograms
Set PCDPartProgram = PCDApp.ActivePartProgram
Set PCDCommands = PCDPartProgram.Commands

Dim MyList$ (16)
MyList (0) =612
MyList (1) =615
MyList (2) =616
MyList (3) =614
MyList (4) =617
MyList (5) =618
MyList (6) =605
MyList (7) =619
MyList (8) =613
MyList (9) =602
MyList (10) =596
MyList (11) =544
MyList (12) =586
MyList (13) =587
MyList (14) =241
MyList (15) =245
MyList (16) =243

Begin Dialog DIALOGNAME1 48,60, 199, 195, "Select"
ComboBox 10,14,24,150, MyList$(), .Combo1
CancelButton 142,172,40,12
OKButton 14,172,40,12
Text 40,28,121,12, "CONTACT_CIRCLE_FEATURE"
Text 40,36,121,12, "CONTACT_CONE_FEATURE"
Text 40,44,121,12, "CONTACT_CYLINDER_FEATURE"
Text 40,52,121,12, "CONTACT_LINE_FEATURE"
Text 40,60,121,12, "CONTACT_PLANE_FEATURE"
Text 40,68,121,12, "CONTACT_SLOT_ROUND_FEATURE"
Text 40,76,121,12, "CONTACT_ANGLE_POINT_FEATURE"
Text 40,84,121,12, "CONTACT_SLOT_SQUARE_FEATURE"
Text 40,92,121,12, "CONTACT_SPHERE_FEATURE"
Text 40,100,121,12, "CONTACT_VECTOR_POINT_FEATURE"
Text 40,108,121,12, "CONST_SET"
Text 40,116,121,12, "CONST_MID_LINE"
Text 40,124,121,12, "CONST_WIDTH2D_FEATURE"
Text 40,132,121,12, "CONST_WIDTH3D_FEATURE"
Text 40,140,121,12, "VISION_SURFACE_POINT_FEATURE"
Text 40,148,121,12, "VISION_CIRCLE_FEATURE"
Text 40,156,121,12, "VISION_LINE_FEATURE"
End Dialog

Dim Dlg1 As DialogName1
Dlg1.Combo1 = "Selection"
button = Dialog( Dlg1 )
If button = 2 Then
Quit
End If

Dim fType As String

PntName = "POINT"
LineName = "AUTOLINE"
CircleName = "AUTOCIRCLE"
RdSlotName = "ROUNDSLOT"
SqSlotName = "SQUARESLOT"
WidthName = "WIDTH"
PlaneName = "AUTOPLANE"
AngleName = "ANGLEPNT"
CylinderName = "AUTOCYLINDER"
ConeName = "AUTOCONE"
SphereName = "AUTOSPHERE"
SetName = "FEATURESET"
MidLineName = "MIDLINE"
VisionPointName = "VISIONPOINT"
VisionCircleName = "VISIONCIRCLE"
VisionLineName = "VISIONLINE"

Select Case Dlg1.Combo1
Case 612
fType = CircleName
Case 615
fType = ConeName
Case 616
fType = CylinderName
Case 614
fType = LineName
Case 617
fType = PlaneName
Case 618
fType = SlotName
Case 605
fType = AngleName
Case 619
fType = SqSlotName
Case 613
fType = SphereName
Case 602
fType = PntName
Case 596
fType = SetName
Case 544
fType = MidLineName
Case 586
fType = WidthName
Case 587
fType = WidthName
Case 241
fType = VisionPointName
Case 245
fType = VisionCircleName
Case 243
fType = VisionCircleName
End Select

Dim aArray$(46) As Integer
aArray(0) = "STARTZ"
aArray(1) = "STARTX"
aArray(2) = "STARTY"
aArray(3) = "STARTXY"
aArray(4) = "PNT1"
aArray(5) = "PNT2"
aArray(6) = "PNT3"
aArray(7) = "PNT4"
aArray(8) = "PNT5"
aArray(9) = "PNT6"
aArray(10) = "PNT7"
aArray(11) = "A1"
aArray(12) = "A2"
aArray(13) = "A3"
aArray(14) = "A4"
aArray(15) = "B1"
aArray(16) = "B2"
aArray(17) = "B3"
aArray(18) = "B4"
aArray(19) = "C1"
aArray(20) = "C2"
aArray(21) = "C3"
aArray(22) = "C4"
aArray(23) = "C5"
aArray(24) = "C6"
aArray(25) = "C7"
aArray(26) = "C8"
aArray(27) = "C9"
aArray(28) = "C10"
aArray(29) = "C11"
aArray(30) = "C12"
aArray(31) = "DATUMA"
aArray(32) = "DATUMB"
aArray(33) = "DATUMC"
aArray(34) = "DATUMD"
aArray(35) = "DATUME"
aArray(36) = "DATUMF"
aArray(37) = "DATUMG"
aArray(38) = "ITERATE1"
aArray(39) = "ITERATE2"
aArray(40) = "ITERATE3"
aArray(41) = "ITERATE4"
aArray(42) = "ITERATE5"
aArray(43) = "ITERATE6"
aArray(44) = "ITERATE7"
aArray(45) = "ROTATE"

For Each PCDCommand In PCDCommands
If PCDCommand.Type = Dlg1.Combo1 Then
vValue = PCDCommand.ID
vType = PCDCommand.Type

For i = 0 To 45
If aArray(i) = vValue Then
GoTo Label1
End If
Next i

FeatureList(Fcntr) = PCDCommand.ID
Fcntr = Fcntr + 1
retval = PCDCommand.PutText (fType & Fcntr, ID, 0)

If Dlg1.Combo1 = 195 Then
dValue = PCDCommand.GetText(133,1)

Select Case dValue
Case dValue = "READX"
GoTo Label1
Case dValue = "READY"
GoTo Label1
Case dValue = "READZ"
GoTo Label1
Case dValue = "ZSTART"
GoTo Label1
Case dValue = "SAMPELNUM"
GoTo Label1
Case dValue = "DATA"
GoTo Label1
End Select

VariableList(Vcntr ) = fType
Vcntr = Vcntr + 1
retval = PCDCommand.PutText (fType & Vcntr , DEST_EXPR, 0)
End If

Label1:
End If

Next PCDCommand

End Sub

Sub Main
Part1
PCDPartProgram.RefreshPart
End Sub
Cancel
Vote Up 0 Vote Down

Sign in to reply

Cancel

Children

No Data