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

Parents

Kp61dude! over 6 years ago

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



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!!!!

Reply

Kp61dude! over 6 years ago



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!!!!

Children

No Data