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

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • 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...

    Code:
    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
    Last edited by AndersI; 05-15-2018, 04:55 AM. Reason: Fixed the comments...
    AndersI
    SW support - Hexagon Metrology Nordic AB

  • #2
    Just gonna go ahead and borrow this...

    Comment


    • #3
      Of course I couldn't keep my hands away (I like coding!), so here's an updated version with a dialog to select what to rename, also can rename dimensions and alignments. Enjoy!

      Note: The dialog was created with the Dialog Designer in the Basic editor (Edit -> Dialog Editor...). It only works if PC-DMIS is started with admin rights (because of Registry access restrictions). It can as easily be created directly in code (if you know what to write).

      Edit: The Dialog Designer is the file dlgdsn.exe in the PC-DMIS folder. It gets a bit better if this .exe is marked for XP compatibility, and started manually outside of PC-DMIS. It still needs admin rights, though, but it runs smoother, with fewer graphics glitches. You can transfer a dialog back and forth between the Designer and Basic by using the Clipboard:

      - Mark and Copy in Basic, File -> Load Dialog from Clipboard in Designer
      - Edit as much as you want
      - File -> Put Dialog on Clipboard in Designer, Paste in Basic

      Code:
      
      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
      Last edited by AndersI; 05-16-2018, 09:14 AM.
      AndersI
      SW support - Hexagon Metrology Nordic AB

      Comment


      • drewk1
        drewk1 commented
        Editing a comment
        Works great. Thank you

    • #4
      Originally posted by AndersI View Post
      Of course I couldn't keep my hands away (I like coding!), so here's an updated version with a dialog to select what to rename, also can rename dimensions and alignments. Enjoy!

      Note: The dialog was created with the Dialog Designer in the Basic editor (Edit -> Dialog Editor...). It only works if PC-DMIS is started with admin rights (because of Registry access restrictions). It can as easily be created directly in code (if you know what to write).

      Edit: The Dialog Designer is the file dlgdsn.exe in the PC-DMIS folder. It gets a bit better if this .exe is marked for XP compatibility, and started manually outside of PC-DMIS. It still needs admin rights, though, but it runs smoother, with fewer graphics glitches. You can transfer a dialog back and forth between the Designer and Basic by using the Clipboard:

      - Mark and Copy in Basic, File -> Load Dialog from Clipboard in Designer
      - Edit as much as you want
      - File -> Put Dialog on Clipboard in Designer, Paste in Basic

      Code:
      
      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
      As the saying goes...'You learn something new everyday'. This will probably take the pie for this month. I never knew this existed(dlgdsn.exe). Thanks Andersl!!!!
      PcDmis 2015.1 SP10 CAD++
      Global 7-10-7 DC800S

      Comment

      Related Topics

      Collapse

      Working...
      X