Simple Rename script - needs work by anyone interested...

There was a question in another part of the forum for a way to rename features in program order. I found the source code of an old EditFeat.VB script in my archives, and have stripped anything VB6 from it, to make [the beginnings] of a script that can run in PC-DMIS Basic.

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