我发的帖子有最简单的统一尺寸，宽高相同的，没做等宽或者等高
遥不可及灬 发表于 2025-1-7 21:51
我发的帖子有最简单的统一尺寸，宽高相同的，没做等宽或者等高
不会改呢，我是菜鸟一个，我想问你一下Private Sub zxdq_Click()
ActiveDocument.BeginCommandGroup "左对齐10mm间距分布" ' 开始撤销组，修改了描述以体现间距变化
DistributeVerticallyWithTenMmSpacing
ActiveDocument.EndCommandGroup'结束撤销组
End Sub
Sub DistributeVerticallyWithTenMmSpacing()
Dim curSelection As ShapeRange
Dim i As Integer
Dim curLeft As Double
Dim curBottom As Double
Dim sortedShapes() As Shape
' 获取当前选定对象
Set curSelection = ActiveSelectionRange
' 检查用户是否选中了至少两个对象
If curSelection.Count < 2 Then
MsgBox "请选中2个或以上数量的对象。"
Exit Sub
End If
If Not curSelection Is Nothing Then
' 创建一个形状数组以便对其进行排序
ReDim sortedShapes(1 To curSelection.Count)
For i = 1 To curSelection.Count
Set sortedShapes(i) = curSelection(i)
Next i
' 按左下角坐标对形状数组进行排序，保证后续能基于此有序排列图形
SortShapesByLeftBottom sortedShapes
' 设置第一个形状的位置
curLeft = sortedShapes(1).LeftX
curBottom = sortedShapes(1).BottomY
' 调整每个对象的位置，实现垂直方向间距为10mm的分布
For i = 1 To UBound(sortedShapes)
sortedShapes(i).LeftX = curLeft
sortedShapes(i).BottomY = curBottom
curBottom = sortedShapes(i).TopY + 10 ' 这里加上10mm间距，更新为下一个对象的底部位置（基于当前对象顶部加间距）
Next i
End If
End Sub
Sub SortShapesByLeftBottom(arr() As Shape)
Dim i As Long
Dim j As Long
Dim tempShape As Shape
For i = LBound(arr) To UBound(arr) - 1
For j = i + 1 To UBound(arr)
' 统一按照先比较LeftX坐标，如果LeftX相同再比较BottomY坐标的逻辑来排序
If arr(j).LeftX < arr(i).LeftX Then
Set tempShape = arr(i)
Set arr(i) = arr(j)
Set arr(j) = tempShape
ElseIf arr(j).LeftX = arr(i).LeftX Then
If arr(j).BottomY < arr(i).BottomY Then
Set tempShape = arr(i)
Set arr(i) = arr(j)
Set arr(j) = tempShape
End If
End If
Next j
Next i
End Sub
Private Sub dydq_Click()
ActiveDocument.BeginCommandGroup '开始撤销组
DistributeHorizontallyWithTenMmSpacing
ActiveDocument.EndCommandGroup '结束撤销组
End Sub
Sub DistributeHorizontallyWithTenMmSpacing()
Dim curSelection As ShapeRange
Dim i As Integer
Dim curLeft As Double
Dim curTop As Double
Dim sortedShapes() As Shape
' 获取当前选定对象
Set curSelection = ActiveSelectionRange
' 检查用户是否选中了至少两个对象
If curSelection.Count < 2 Then
MsgBox "请选中2个或以上数量的对象。"
Exit Sub
End If
If Not curSelection Is Nothing Then
' 创建一个形状数组以便对其进行排序
ReDim sortedShapes(1 To curSelection.Count)
For i = 1 To curSelection.Count
Set sortedShapes(i) = curSelection(i)
Next i
' 按左下角坐标对形状数组进行排序（这里使用统一后的SortShapesByLeftBottom过程）
SortShapesByLeftBottom sortedShapes
' 设置第一个形状的位置
curLeft = sortedShapes(1).LeftX
curTop = sortedShapes(1).TopY
' 调整每个对象的位置，实现水平方向间距为10mm的分布
For i = 1 To UBound(sortedShapes)
sortedShapes(i).LeftX = curLeft
sortedShapes(i).TopY = curTop
curLeft = sortedShapes(i).RightX + 10 ' 这里加上10mm间距，更新为下一个对象的左边位置（基于当前对象右边加间距）
Next i
End If
End Sub
向下对齐是忘上面跑的，这是你插件的代码。
本帖最后由 遥不可及灬 于 2025-1-8 17:45 编辑
http://8.141.85.246:7791/i/2025/01/08/677e35d625d95.png
最近没有时间
是这种吧，没你那么高级。:lol
是要这样效果吗？不然别下载哦
https://www.123684.com/s/9QUSVv-cXU3A?提取码:**** 本内容需购买 ****
现在印币这么贬值了吗？一个软件自带的简单功能要200个币？随便一个原创的脚本或者GMS都是一两百个币，
遥不可及灬 发表于 2025-1-9 14:52
是要这样效果吗？不然别下载哦
https://www.123684.com/s/9QUSVv-cXU3A?提取码:**** 本内容需购买 **** ...
我想要的效果是右上对齐，左下对齐，但是你这个左是往上的
很好是的 发表于 2025-1-9 16:26
现在印币这么贬值了吗？一个软件自带的简单功能要200个币？随便一个原创的脚本或者GMS都是一两百个币， ...
这属于定制啊，只有他一个人有这个需求啊，你什么软件自带这个功能一键设置间距 对齐？
印币对我来说，不能兑换RMB，只是希望有需要的在论坛充值。
你找找人定制，看人家手机印币还是RMB
本帖最后由 很好是的 于 2025-1-9 18:45 编辑
遥不可及灬 发表于 2025-1-9 17:38
这属于定制啊，只有他一个人有这个需求啊，你什么软件自带这个功能一键设置间距 对齐？
印币对我来说，不 ...
CDR自带的对齐和分布点两下，你这个点一下
遥不可及灬 发表于 2025-1-9 14:52
是要这样效果吗？不然别下载哦
https://www.123684.com/s/9QUSVv-cXU3A?提取码:**** 本内容需购买 **** ...
这个是我自己写的,被你们各种改,我有完整版本的,你要吗