根据 Coreldraw 中的初始对象尺寸计算更改对象名称

Question

我想问一下。 “以前，我已经在绿线上创建了对象名称 A-Z”，我正在尝试创建 VBA 代码，代码如下：

Sub ChangeObjectName()
    Dim sr As ShapeRange
    Dim s As Shape, s2 As Shape, s1 As Shape
    Dim newName As String
    Dim foundAlpha As Boolean
    Const START_NAME = "A"
    Const END_NAME = "Z"
    
    Set sr = ActiveSelectionRange
    If sr.Count <> 2 Then Exit Sub
    
    For Each s In sr
        If Len(s.Name) = 1 And s.Name Like "[A-Z]" Then
            foundAlpha = True
            Set s1 = s
        Else
            Set s2 = s
        End If
    Next s
    
    If Not foundAlpha Then Exit Sub
    
    If s1 Is Nothing Or s2 Is Nothing Then Exit Sub
    
    newName = CStr(Asc(s1.Name) - 64)
    s2.Name = newName
End Sub

此代码用于根据对象名称字母（A-Z）更改对象的名称。当选择 2 个对象时，该代码将起作用。如果对象名称为 (B)，则另一个对象的名称将更改为 (2)。如果选择 (E)，则脚本将把对象的名称更改为 (5)，依此类推。

是否可以更新代码，使其能够更优化地工作，而不必一一运行？我的意思是，这些对象以前是同一实体的一部分。通过在代码中添加宽度和高度（对象大小）/相同旋转值的计算，是否可以自动将非字母的对象名称按顺序更改为数字？

我做了很多尝试，但仍然没有成功。

Sub ChangeObjectName()
    Dim sr As ShapeRange
    Dim s As Shape
    Dim alphaShape As Shape
    Dim alphaName As String
    Dim numericName As Integer
    Dim matchingShapes As New Collection
    Dim i As Integer, j As Integer
    Dim matchFound As Boolean
    
    Set sr = ActiveSelectionRange
    
    For Each s In sr
        If Len(s.Name) = 1 And s.Name Like "[A-Z]" Then
            alphaName = s.Name
            Set alphaShape = s
            Exit For
        End If
    Next s
    
    If alphaShape Is Nothing Then
        MsgBox "Tidak ada objek alfabet yang ditemukan.", vbExclamation
        Exit Sub
    End If
    
    For Each s In sr
        If s.Name <> alphaName Then
            If s.SizeWidth = alphaShape.SizeWidth And s.SizeHeight = alphaShape.SizeHeight And s.Rotation = alphaShape.Rotation Then
                matchingShapes.Add s
            End If
        End If
    Next s
    
    numericName = 1
    For i = 1 To matchingShapes.Count
        matchFound = False
        For j = 1 To sr.Count
            If sr(j).Name = matchingShapes(i).Name Then
                sr(j).Name = Chr(64 + numericName)
                matchFound = True
                Exit For
            End If
        Next j
        If matchFound Then
            numericName = numericName + 1
        End If
    Next i
    
 End Sub

Answer 1

注意：这是未经测试的代码（没有 coreldraw sw.）。测试前请备份您的文件。

Sub ChangeObjectName()
    Dim sr As ShapeRange
    Dim s As Shape
    Dim alphaShape As Shape
    Dim alphaName As String
    Dim numericName As Integer
    Dim matchingShapes As New Collection
    Dim i As Integer, j As Integer
    Dim matchFound As Boolean
    
    Set sr = ActiveSelectionRange
    ' Save all shapes with alpha name into Collection
    For Each s In sr
        If Len(s.Name) = 1 And s.Name Like "[A-Z]" Then
            matchingShapes.Add s
        End If
    Next s
    ' Loop through Collection
    For i = 1 To matchingShapes.Count
        ' Get the shape
        set alphaShape = matchingShapes(i)
        For j = 1 To sr.Count
            ' shape name is different
            If sr(j).Name <> alphaShape.Name Then
                ' shape properties are same
                If sr(j).SizeWidth = alphaShape.SizeWidth And sr(j).SizeHeight = alphaShape.SizeHeight And sr(j).Rotation = alphaShape.Rotation Then
                    ' Update shape name with digit
                    sr(j).Name = CStr(Asc(alphaShape.Name) - 64)
                End If
            End If
        Next j
    Next  
 End Sub