CorelDRAW 批量排序,自由设置间隔，最近更新支持X4

landboy · 发表于 2023-7-25 10:06:14

本帖最后由 landboy 于 2023-7-25 10:12 编辑

CorelDRAW 批量排序,自由设置间隔，最近更新支持X4{tag}(1)

先发源码部分，动手能力强的同学可以搞成单独gms发上来赚取一起积分

'// 简易火车排列
Public Function Simple_TrAIn_Arrangement(Space_Width As Double)
Dim ssr As ShapeRange, s As Shape
Dim cnt As Integer
Set ssr = ActiveSelectionRange
cnt = 1
#If VBA7 Then
ssr.Sort " @shape1.left<@shape2.left"
#Else
' X4 不支持 ShapeRange.sort 使用 lyvba32.dll 算法库排序 2023.07.08
Set ssr = X4_Sort_ShapeRange(ssr, stlx)
#End If
ActiveDocument.ReferencePoint = CDRTopLeft
For Each s In ssr
'// 底对齐 If cnt > 1 Then s.SetPosition ssr(cnt - 1).RightX, ssr(cnt - 1).BottomY
'// 改成顶对齐 2022-08-10
ActiveDocument.ReferencePoint = cdrTopLeft + cdrBottomTop
If cnt > 1 Then s.SetPosition ssr(cnt - 1).RightX + Space_Width, ssr(cnt - 1).TopY
cnt = cnt + 1
Next s
End Function
'// 简易阶梯排列
Public Function Simple_Ladder_Arrangement(Space_Width As Double)
Dim ssr As ShapeRange, s As Shape
Dim cnt As Integer
Set ssr = ActiveSelectionRange
cnt = 1
#If VBA7 Then
ssr.Sort " @shape1.top>@shape2.top"
#Else
' X4 不支持 ShapeRange.sort 使用 lyvba32.dll 算法库排序 2023.07.08
Set ssr = X4_Sort_ShapeRange(ssr, stty).ReverseRange
#End If
ActiveDocument.ReferencePoint = cdrTopLeft
For Each s In ssr
If cnt > 1 Then s.SetPosition ssr(cnt - 1).LeftX, ssr(cnt - 1).BottomY - Space_Width
cnt = cnt + 1
Next s
End Function