CorelDRAW VBA插件开发 使用ShapeRange和字典

【CorelDRAW VBA插件开发 使用ShapeRange和字典-哔哩哔哩】 https://b23.tv/V5TmFOp

简介 这段 CorelDRAW VBA 学习代码实现了一个功能，即对所选形状进行颜色索引和统计。

Sub 制作颜色索引()
  Dim sr As ShapeRange
  Dim csr As New ShapeRange
  Dim s As Shape
  Dim rgb As New Color
  Set sr = ActiveSelectionRange

  Set dict = CreateObject("Scripting.dictionary")

  For Each s In sr
    rgb.CopyAssign s.Fill.UniformColor
    rgb.ConvertToRGB
    '//  Debug.Print rgb.ToString

    '// 使用RGB颜色建立字典和计数
    If dict.Exists(rgb.ToString) = True Then
      dict.Item(rgb.ToString) = dict.Item(rgb.ToString) + 1
    Else
      dict.Add rgb.ToString, 1
      csr.Add s
    End If
  Next s

  MsgBox "颜色统计: " & csr.Count & " 种填充颜色" & vbNewLine & "索引颜色第一个物件在 csr 物件范围内"
  csr.CreateSelection

End Sub

下面来分段解释,代码的主要逻辑如下：

• 声明了一些变量，包括ShapeRange对象sr和csr，Shape对象s，Color对象rgb，以及一个字典对象dict。

  Dim sr As ShapeRange
  Dim csr As New ShapeRange
  Dim s As Shape
  Dim rgb As New Color

• 通过Set sr = ActiveSelectionRange获取当前的选中形状范围。

• 创建一个Scripting.dictionary对象dict，用于存储颜色和计数的信息。

• 使用一个循环遍历选中形状范围中的每个形状s

• 将当前形状s的填充颜色复制给Color对象rgb，并将其转换为RGB颜色空间。

  rgb.CopyAssign s.Fill.UniformColor
  rgb.ConvertToRGB
  Debug.Print rgb.ToString

• 学习代码的时候，可以使用 Debug.Print 把调试信息打印出来检查

• 使用RGB颜色作为键，在字典dict中进行查找。如果字典中已存在该键，则将对应的值加1；如果字典中不存在该键，则将该键和值1添加到字典中，并将当前形状s添加到csr中。

  If dict.Exists(rgb.ToString) = True Then
  dict.Item(rgb.ToString) = dict.Item(rgb.ToString) + 1
  Else
  dict.Add rgb.ToString, 1
  csr.Add s
  End If

• 循环结束后，使用csr.Count获取csr中形状的数量，弹出一个消息框显示颜色统计结果，并将csr中的形状创建为新的选中范围。
  csr.CreateSelection

总结来说，这段代码的作用是对所选形状的填充颜色进行索引和统计，并将具有相同填充颜色的形状放入一个ShapeRange对象中。最后，通过消息框显示统计结果，并将这些形状作为新的选中范围。