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

Sub Main

'      This is a program which goes through the entire current program And renames features,
'      dimensions And alignments 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 PartProg As Object
    Set PartProg = App.ActivePartProgram
    Dim Cmds As Object
    Set Cmds = PartProg.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 AllName As String
    Dim PointName As String
    Dim LineName As String
    Dim CircName As String
    Dim PlaneName As String
    Dim CylinderName As String
    Dim ConeName As String
    Dim SphereName As String
    Dim DimensionName As String
    Dim AlignmentName As String

    Dim DoAll As Boolean
    Dim DoPoint As Boolean
    Dim DoLine As Boolean
    Dim DoCircle As Boolean
    Dim DoPlane As Boolean
    Dim DoCylinder As Boolean
    Dim DoCone As Boolean
    Dim DoSphere As Boolean
    Dim DoDimension As Boolean
    Dim DoAlignment As Boolean

    Dim NewId As String

    AllName = "FEAT"
    PointName = "PNT"
    LineName = "LIN"
    CircName = "CIR"
    PlaneName = "PLN"
    CylinderName ="CYL"
    ConeName = "CON"
    SphereName = "SPH"
    DimensionName = "DIM"
    AlignmentName = "ALN"

    ' Dialog

    Begin Dialog DLGRENAMER 150,2, 137, 259, "Renamer 1.0"
      CheckBox 8,8,60,16, "Alignments", .cbAln
      CheckBox 8,123,60,16, "Planes", .cbPln
      CheckBox 8,100,60,16, "Circles", .cbCir
      CheckBox 8,77,60,16, "Lines", .cbLin
      CheckBox 8,54,60,16, "Points", .cbPnt
      CheckBox 8,31,60,16, "Dimensions", .cbDim
      CheckBox 8,146,60,16, "Cylinders", .cbCyl
      CheckBox 8,169,60,16, "Cones", .cbCon
      CheckBox 8,192,60,16, "Spheres", .cbSph
      CheckBox 8,215,60,16, "All...", .cbAll
      TextBox 76,10,37,12, .edAln
      TextBox 76,33,37,12, .edDim
      TextBox 76,56,37,12, .edPnt
      TextBox 76,79,37,12, .edLin
      TextBox 76,102,37,12, .edCir
      TextBox 76,125,37,12, .edPln
      TextBox 76,148,37,12, .edCyl
      TextBox 76,171,37,12, .edCon
      TextBox 76,194,37,12, .edSph
      TextBox 76,217,37,12, .edAll
      OKButton 76,240,37,12
      CancelButton 12,240,37,12
    End Dialog

    Dim DlgRen As DLGRENAMER

Repeat_Dialog:

    DlgRen.edAll = AllName
    DlgRen.edPnt = PointName
    DlgRen.edLin = LineName
    DlgRen.edCir = CircName
    DlgRen.edPln = PlaneName
    DlgRen.edCyl = CylinderName
    DlgRen.edCon = ConeName
    DlgRen.edSph = SphereName
    DlgRen.edDim = DimensionName
    DlgRen.edAln = AlignmentName

    rc = Dialog(DlgRen)

    If rc <> 0 Then

      AllNum = 1
      PointNum = 1
      LineNum = 1
      CircNum = 1
      PlaneNum = 1
      CylinderNum = 1
      ConeNum = 1
      SphereNum = 1
      DimensionNum = 1
      AlignmentNum = 1

      AllName = DlgRen.edAll
      PointName = DlgRen.edPnt
      LineName = DlgRen.edLin
      CircName = DlgRen.edCir
      PlaneName = DlgRen.edPln
      CylinderName = DlgRen.edCyl
      ConeName = DlgRen.edCon
      SphereName = DlgRen.edSph
      DimensionName = DlgRen.edDim
      AlignmentName = DlgRen.edAln

      DoPoint  = DlgRen.cbPnt
      DoLine  = DlgRen.cbLin
      DoCircle  = DlgRen.cbCir
      DoPlane  = DlgRen.cbPln
      DoCylinder  = DlgRen.cbCyl
      DoCone  = DlgRen.cbCon
      DoSphere  = DlgRen.cbSph
      DoDimension  = DlgRen.cbDim
      DoAlignment  = DlgRen.cbAln
      DoAll = DlgRen.cbAll

      If DoAll Then
        DoPoint  = False
        DoLine  = False
        DoCircle  = False
        DoPlane  = False
        DoCylinder  = False
        DoCone  = False
        DoSphere  = False
      End If

'  cycle through the commands In the program, performing the rename

      For Each Cmd In Cmds
        If Cmd.IsFeature And Cmd.ID <> "" Then
          If Doall Then
            NewId = AllName & AllNum
            Cmd.ID = NewId
            AllNum = AllNum + 1
          End If
          If Cmd.Feature = F_POINT And DoPoint Then
            NewId = PointName & PointNum
            Cmd.ID = NewId
            PointNum = PointNum + 1
          End If
          If Cmd.Feature = F_LINE And DoLine Then
            NewId = LineName & LineNum
            Cmd.ID = NewId
            LineNum = LineNum + 1
          End If
          If Cmd.Feature = F_CIRCLE And DoCircle Then
            NewId = CircName & CircNum
            Cmd.ID = NewId
            CircNum = CircNum + 1
          End If
          If Cmd.Feature = F_PLANE And DoPlane Then
            NewId = PlaneName & PlaneNum
            Cmd.ID = NewId
            PlaneNum = PlaneNum + 1
          End If
          If Cmd.Feature = F_CYLINDER And DoCyl Then
            NewId = CylinderName & CylinderNum
            Cmd.ID = NewId
            CylinderNum = CylinderNum + 1
          End If
          If Cmd.Feature = F_SPHERE And DoSph Then
            NewId = SphereName & SphereNum
            Cmd.ID = NewId
            SphereNum = SphereNum + 1
          End If
        ElseIf Cmd.IsDimension And DoDimension And Cmd.ID <> "" Then
            NewId = DimensionName & DimensionNum
            Cmd.ID = NewId
            DimensionNum = DimensionNum + 1
        ElseIf Cmd.IsAlignment And DoAlignment And Cmd.ID <> "STARTUP" And Cmd.ID <> "" Then
              NewId = AlignmentName & AlignmentNum
              Cmd.ID = NewId
              AlignmentNum = AlignmentNum + 1
        End If
      Next Cmd
      PartProg.RefreshPart
      GoTo Repeat_Dialog
  End If
End Sub