hexagon logo

Removing duplicate names from part program

When we copy some code from a part program and paste it in other part program we can get a duplicate names to features or dimensions, it happens because you can use a default names to features and dimensions in both part programs.
Ok, imagine you have a lot of features and dimensions, it's can be a hard work rename all features, ok you can imagine "Why I would need to rename features?" because in few versions we can get problems, we know the pc-dmis rename internally, but it's don't work in a few older versions.
If you still want know how to do this, here we go:

Dim i As Integer, j As Integer, Ncmd As Integer
Dim Cmd As Object
Dim PP2 As Object
Dim PP As Object
Dim NomePrograma As String
Dim nTotal As Integer
Dim ElementoBase(0 To 100) As String
Dim PCD As Object
Dim Cmds As Object
Dim Nomes() As String
Dim NomeAnt As String
Dim Nnomecor As Integer

Public Sub Main()
    ReDim Nomes(0 To 10000)
    For i=0 To 10000
        Nomes(i) = ""
    Next
    Ncmd = 0
    Nnomecor = 0
    Set PCD = CreateObject("PCDLRN.Application")
    Set PP = PCD.ActivePartProgram
    If PP.FullName = "" Then
        MsgBox "Não há programa aberto!"
        End
    End If
    NomePrograma = PP.FullName
    NomePrograma = Left(NomePrograma, InStr(1, NomePrograma, ".") - 1) & "_HEX.prg"
    PP.SaveAs NomePrograma
    PP.Close
    Set PP = Nothing
    Set PP2 = PCD.PartPrograms.Open(NomePrograma, "OffLine")
    PP2.EditWindow.CommandMode
    PP2.RefreshPart
    Set Cmds = PP2.Commands
    nTotal = 0
    For Each Cmd In Cmds
        If Cmd.Type = 517 Or Cmd.IsDimension Or Cmd.IsConstructedFeature Then nTotal = nTotal + 1
        If Cmd.ID = "" Or Cmd.Type = 60 Or Cmd.Type = 10 Then GoTo Foge
Repete:
        For i = 0 To Ncmd
            If Cmd.ID = Nomes(i) And Cmd.Type <> 51 Then
                NomeAnt = Cmd.ID
                Cmd.ID = Mid(Cmd.ID, 1, Len(Cmd.ID) - (InStr(1, Cmd.ID, "_HEX") - 1)) & "_HEX_" & Nnomecor + 1
                Nnomecor = Nnomecor + 1
                GoTo Repete
            End If
        Next i
        Cmd.ReDraw
        Nomes(Ncmd) = Cmd.ID
        Ncmd = Ncmd + 1
Foge:
    Next Cmd
    PP2.EditWindow.SummaryMode
    PP2.EditWindow.CommandMode
    Set Cmds = Nothing
    Set Cmd = Nothing
    Set PP2 = Nothing
End Sub
  • Can anyone explain how to use this? Trying to get it working with no luck.


    I opened the script editor(View/Basic Script Editor), then I pasted the code into window and saved as "Rename.bas"
    Then I inserted it(Insert/Basic Script) at the end of a program that I had copied and pasted the same feature(I had two CIR2 features).
    I marked all and placed the cursor above the script command, then hit CTL U to run from cursor.
    I then had a feature named CIR2 and one named CIR2_HEX_1.

    There may be a better way to run it, but this worked for me, although I'm not fond of putting a "hex" on all those features, it worked.

    It also saves the changed program with "_HEX" at the end.