xiyanghxc 发表于 2025-5-7 18:09:42

本帖最后由 xiyanghxc 于 2025-5-7 18:12 编辑

下面这个生成的代码没反应,不知是哪里问题?

以下是为 CorelDRAW 2024 编写的 VBA 宏,
用于按对象从左到右的顺序调整其叠放顺序(Z顺序),
确保最左侧的对象位于最上层:

vba
Sub ArrangeObjectsByLeftPosition()
    Dim pg As Page
    Dim sh As Shape
    Dim shapeList() As Shape
    Dim i As Long, j As Long
    Dim tempSh As Shape
   
    ' 检查当前页面
    Set pg = ActivePage
    If pg.Shapes.Count = 0 Then Exit Sub
   
    ' 收集所有对象到数组
    ReDim shapeList(1 To pg.Shapes.Count)
    i = 0
    For Each sh In pg.Shapes
      i = i + 1
      Set shapeList(i) = sh
    Next
   
    ' 冒泡排序(按X坐标升序)
    For i = 1 To UBound(shapeList) - 1
      For j = i + 1 To UBound(shapeList)
            If shapeList(i).Left > shapeList(j).Left Then
                Set tempSh = shapeList(i)
                Set shapeList(i) = shapeList(j)
                Set shapeList(j) = tempSh
            End If
      Next j
    Next i
   
    ' 从右到左调整Z顺序(最后处理最左侧对象)
    For i = UBound(shapeList) To 1 Step -1
      shapeList(i).OrderToFront
      DoEvents
    Next i
   
    MsgBox "已完成对象排序!最左侧对象现在位于最上层。", vbInformation
End Sub

petergh 发表于 2025-5-7 21:29:27

本帖最后由 petergh 于 2025-5-7 21:31 编辑

xiyanghxc 发表于 2025-5-7 18:09
下面这个生成的代码没反应,不知是哪里问题?

以下是为 CorelDRAW 2024 编写的 VBA 宏,

这段程序应该只是把对象存在数组,然后做了一个逻辑排序,没有输出什么信息。

夜的影子 发表于 2025-5-8 14:45:13


Sub 按左边排序()
    VGCore.ActiveDocument.BeginCommandGroup "按左边排序"
    Dim userSelect As VGCore.ShapeRange
    Set userSelect = VGCore.ActiveSelectionRange
   'PrintShapesName userSelect.Shapes
    userSelect.Sort "@shape1.com().LeftX>@shape2.com().LeftX"’重点在这一句,如果换成TopY就是顶端、BottomY就是底端、RightX是右边、PositionX是中心。
    Dim S1 As VGCore.Shape
    Set S1 = userSelect.Shapes(userSelect.Count)
   
    For I = 1 To userSelect.Count
      userSelect.Shapes(I).OrderToBack
    Next
    VGCore.ActiveDocument.EndCommandGroup
End Sub

彩广告 发表于 2025-5-8 19:54:31

这个有啥作用来的。
页: 1 [2]
查看完整版本: 求vba代码对对象在图层的顺序重排