hexagon logo

Change Names of Dimension Names

I need to change the names of any dimension with name like INSP_16_1X to INSP_16A. 

I wanted to do this programmatically. 

I'm most of the way there, but I think I'm using the wrong Enumeration value to get the NAME of the dimension. (So that I can SET the NAME of the dimension.)

Here's the code: It runs, but 

Sub main()
    Dim App As Object
    Dim Part As Object
    Dim dmis_version_string As String
    Dim DmisCommands As Object
    Dim DmisCommand As Object
    Dim command_count As Integer
    Dim old_dimension_name as String
    Dim new_dimension_name as String


    Set App = CreateObject("PCDLRN.Application")
    Set Part = App.ActivePartProgram

    dmis_version_string = App.VersionString

    If UCase(dmis_version_string) <> "2020 R2" Then
        MsgBox "It's not running in 2020."
        Exit Sub
    End If


    Set DmisCommands = Part.Commands

    command_count = DmisCommands.Count
    Set DmisCommand = DmisCommands.Item(2)

    DmisCommands.InsertionPointAfter DmisCommand

    For Each DmisCommand In DmisCommands
        If DmisCommand.IsDimension() Then
            old_dimension_name = DmisCommand.GetText(182, 0)
            if len(old_dimension_name) > 0 Then
                new_dimension_name = GetDimensionName(old_dimension_name)

                If old_dimension_name <> new_dimension_name Then
                    DmisCommand.PutText new_dimension_name, 182, 0
                End If
            end if
        End If
    Next

End Sub


Function GetDimensionName(search_value As String)
    Dim regex_pattern As String
    Dim regEx As Object
    Dim Matches As Object
    Dim SubMatches As Object
    Dim Match As Object
    'INSP_78_1X= PROFILE OF SURFACE OF SET BK_SCN FORMANDLOCATION
    regex_pattern = "(INSP_)(\d+)_(\d+)(?:X*)(\=.+)"
    Set regEx = CreateObject("VBScript.RegExp")

    regEx.pattern = regex_pattern
    regEx.IgnoreCase = True
    regEx.Global = True
    Set Matches = regEx.Execute(search_value)

    If Matches.count = 0 Then
        GetDimensionName = search_value
        Exit Function
    End If

    Set SubMatches = Matches(0).SubMatches
    If SubMatches.count() <> 4 Then
        GetDimensionName = search_value
        Exit Function
    Else
        GetDimensionName = SubMatches(0) + SubMatches(1) + ConvertToLetter(CInt(SubMatches(2))) + SubMatches(3)
    End If


End Function

Function ConvertToLetter(number_value As Integer) As String
    Dim c As String

    If (number_value > 0) And (number_value < 27) Then
        c = Chr(number_value + 64)
        ConvertToLetter = c
    Else
        ConvertToLetter = ""
    End If
End Function

Parents Reply Children
No Data