CorelDRAW 批量排序,自由设置间隔，最近更新支持X4
本帖最后由 landboy 于 2023-7-25 10:12 编辑先发源码部分，动手能力强的同学可以搞成单独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
代码高亮的源码图，方便阅读
直接从集成插件里导出个GMS，方便大家学习
由于本论坛没法编辑帖子，请下载的同学顶下有 GMS附件的这楼 兰老大，你不如直接发成品吧，照顾一下我这些弱势群体。:lol 兰老大 有没有获取尺寸后在下方生成尺寸文本的代码 yiweimeigong 发表于 2023-7-25 10:09
兰老大，你不如直接发成品吧，照顾一下我这些弱势群体。
已经集成到Lanya Corelvba Plug-In For Coreldraw X4-2023
这个功能是我每天必用的，因为我每天使用 X4 计算很多拼版
今天如果空闲的话，我单独提取一下，方便大家学习 Long~~~ 发表于 2023-7-25 10:14
兰老大 有没有获取尺寸后在下方生成尺寸文本的代码
标准在物件上方正好有 支持更高版本不？对于异形拼版效果如何 landboy 发表于 2023-7-25 10:15
已经集成到Lanya Corelvba Plug-In For Coreldraw X4-2023
这个功能是我每天必用的，因为我每天使用 X4 ...
兰老大，请分享一下“Lanya Corelvba Plug-In For Coreldraw X4-2023”这个呗:lol 老大把Lanya Corelvba Plug-In For Coreldraw X4-2023发出来，购买也行的。
页:
[1]