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


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

        Working...
        X