求这2个插件的GMS

遥不可及灬 · 发表于 2025-1-7 21:51:46

我发的帖子有最简单的统一尺寸，宽高相同的，没做等宽或者等高

菲凡制版 · 发表于 2025-1-8 14:07:19

遥不可及灬发表于 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
向下对齐是忘上面跑的，这是你插件的代码。