判断选择物件是否是相同尺寸，分别两种样式
'// 快速标注尺寸样式
Private Sub QuickStyle_Click()
Dim os As ShapeRange
Set os = ActiveSelectionRange
SRMInst 3, "sw"
CutLines.Dimension_MarkLines cdrAlignTop, True
make_sizes_sep "upbx", 2, True
SRMInst 4, "sw"
SRMInst 3, "lw"
CutLines.Dimension_MarkLines cdrAlignLeft, False
make_sizes_sep "lfbx", Shift, False
SRMInst 4, "lw"
Dim sr As ShapeRange
Set sr = ActiveSelectionRange
sr.Sort "@shape1.left<@shape2.left"
If sr.Count > 5 And IsAllSameSize(os) Then
n = sr.Count
sr.Remove n: sr.Remove (n - 1)
sr.Remove 3: sr.Remove 2: sr.Remove 1
sr.Delete
End If
SRMInst 3, "lw"
End Sub
'// 函数：判断 ShapeRange 中的所有物件尺寸是否相同
Function IsAllSameSize(sr As ShapeRange) As Boolean
Dim s As Shape
Dim tol As Double: tol = 0.01
For Each s In sr
If Abs(s.SizeWidth - sr.FirstShape.SizeWidth) > tol Or _
Abs(s.SizeHeight - sr.FirstShape.SizeHeight) > tol Then
IsAllSameSize = False
Exit Function
End If
Next s
IsAllSameSize = True
End Function
'// 标注文字红色，分离标注
Private Sub QuickRedText_Click()
SRMInst 3, "sw"
'// 选择文本，改成红色
ModulePlus.Dimension_Select_or_Delete 4
Dim sr As ShapeRange
Set sr = ActiveSelectionRange
sr.ApplyUniformFill CreateCMYKColor(0, 100, 100, 0)
'// 解绑标注线
SRMInst 3, "lw"
ModulePlus.Untie_MarkLines
SRMInst 3, "lw"
End Sub
