How to remove underscore at the end of the body name

[jzecha]

I have a macro that I run that removes/replaces all the symbols in part body names prior to running a part2product macro.

This macro works great because I receive some horrilby named parts from some of our custoemrs.

The only issue is that I replace the symbols with an underscore and sometimes I end up with an underscore at the end of the name.

I have done some digging and cant find the right code to be able to remove underscores from the end of the name.

If someone can please provide me with the correct code, it would be greatly appreicaticated.

Here is the current code I have:

Sub CATMain()

CATIA.RefreshDisplay = False

Dim myPart As Part
Set myPart = CATIA.ActiveDocument.Part

Dim myBody As Body

Dim newName As String
Dim newCharacter As String
newCharacter = " "

For Each myBody In myPart.Bodies 'loop through all the bodies in the part

    newName = myBody.name 'get the current body's name

    newName = Replace(newName, ".", "_")
    newName = Replace(newName, ",", "_")
    newName = Replace(newName, "(", "_")
    newName = Replace(newName, ")", "_")
    newName = Replace(newName, "[", "_")
    newName = Replace(newName, "]", "_")
    newName = Replace(newName, "{", "_")
    newName = Replace(newName, "}", "_")
    newName = Replace(newName, "/", "_")
    newName = Replace(newName, "\", "_")
    newName = Replace(newName, "#", "_")
    newName = Replace(newName, "$", "_")
    newName = Replace(newName, "%", "_")
    newName = Replace(newName, "*", "_")
    newName = Replace(newName, " ", "_")
    newName = Replace(newName, "____", "_")
    newName = Replace(newName, "___", "_")
    newName = Replace(newName, "__", "_")

myBody.name = newName 'rename the current body with the revised name

Next

MsgBox "All Done Removing Symbols From Part Body Names!"

Call Rename_Duplicate_Parts

End Sub

 

[LWolf]

If Right(newName, 1) = "_" Then newName = Left(newName, Len(newName) - 1)
put it before myBody.name line...

regards,
LWolf

 

[weagan22]

A little twist to your code makes it more robust. Even if you don't like the ASCII codes, using the sub routine will make your original code easier to read and simplified.

Sub CATMain()

    CATIA.RefreshDisplay = False
    
    Dim myPart As Part
    Set myPart = CATIA.ActiveDocument.Part
    
    Dim myBody As Body
    For Each myBody In myPart.Bodies 'loop through all the bodies in the part
        
        Dim newName As String
        newName = myBody.Name 'get the current body's name
        
        Dim i As Integer
        'ASCII: 33(!), 34("), 35(#), 36($), 37(%), 38(&), 39('), 40((), 41()), 42(*), 43(+), 44(,), 45(-), 46(.), 47(/)
        For i = 33 To 47
            Call ChrReplace(newName, chr(i))
        Next
        
        'ASCII: 58(:), 59(;), 60(<), 61(=), 62(>), 63(?), 64(@)
        For i = 58 To 64
            Call ChrReplace(newName, chr(i))
        Next
        
        'ASCII: 91([), 92(\), 93(]), 94(^), 95(_), 96(`)
        For i = 91 To 96
            Call ChrReplace(newName, chr(i))
        Next
        
       'ASCII: 123({), 124(|), 125(}), 126(~)
         For i = 123 To 126
            Call ChrReplace(newName, chr(i))
        Next
        
        'Remove spaces and duplicate replacements
        Call ChrReplace(newName, " ")
        Call ChrReplace(newName, "____")
        Call ChrReplace(newName, "___")
        Call ChrReplace(newName, "__")
        
        'Remove leading or trailing replacements
        If Right(newName, 1) = "_" Then
            newName = Left(newName, Len(newName) - 1)
        End If
        
        If Left(newName, 1) = "_" Then
            newName = Right(newName, Len(newName) - 1)
        End If
    
        'Rename the current body with the revised name
        myBody.Name = newName
    
    Next
    
    MsgBox "All Done Removing Symbols From Part Body Names!"
    
    'Dont forget to turn this back on
    'CATIA.RefreshDisplay = True
    
    Call Rename_Duplicate_Parts

End Sub

Sub ChrReplace(ByRef newName As String, chr As String)
    newName = Replace(newName, chr, "_")
End Sub