As it stands now, it renames all POINTS, LINES, CIRCLES, PLANES, CYLINDERS, and SPHERES - hardwired three letter name plus an incrementing number according to the type. It should be straightforward to remove unwanted parts of the script, or add blocks for other feature types. It should also be relatively easy to add a dialog and do selective renaming, but all that is left as exercises for the reader...
Sub Main
' This is a program which goes through the entire current program And renames features
' by their Type And also With an increment according To
' the relative position In the part program.
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 PointNum As Integer
Dim LineNum As Integer
Dim CircNum As Integer
Dim PlaneNum As Integer
Dim CylinderNum As Integer
Dim ConeNum As Integer
Dim SphereNum As Integer
Dim DimensionNum As Integer
Dim AlignmentNum As Integer
Dim ContinueOn As String
AllNum = 1
PointNum = 1
LineNum = 1
CircNum = 1
PlaneNum = 1
CylinderNum = 1
ConeNum = 1
SphereNum = 1
DimensionNum = 1
AlignmentNum = 1
Dim NewId As String
' cycle through the commands In the program, performing the rename
For Each Cmd In Cmds
If Cmd.Feature = F_POINT Then
NewId = "PNT" & PointNum
Cmd.ID = NewId
PointNum = PointNum + 1
End If
If Cmd.Feature = F_LINE Then
NewId = "LIN" & LineNum
Cmd.ID = NewId
LineNum = LineNum + 1
End If
If Cmd.Feature = F_CIRCLE Then
NewId = "CIR" & CircNum
Cmd.ID = NewId
CircNum = CircNum + 1
End If
If Cmd.Feature = F_PLANE Then
NewId = "PLN" & PlaneNum
Cmd.ID = NewId
PlaneNum = PlaneNum + 1
End If
If Cmd.Feature = F_CYLINDER Then
NewId = "CYL" & CylinderNum
Cmd.ID = NewId
CylinderNum = CylinderNum + 1
End If
If Cmd.Feature = F_SPHERE Then
NewId = "SPH" & SphereNum
Cmd.ID = NewId
SphereNum = SphereNum + 1
End If
Next Cmd
End
End Sub
