sort.bas 1.7 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768
  1. ## CorelDRAW 好像没有多个物件的对准排列,工作中又经常用到,所以写了个简单代码
  2. ```
  3. Sub 傻瓜火车排列()
  4. ActiveDocument.ReferencePoint = cdrBottomLeft '// 设置对准基准 左下
  5. Dim ssr As ShapeRange, s As Shape '// 定义选择物件数组 ssr, 和遍历物件 s
  6. Dim cnt As Integer '// 定义物件个数计数器
  7. Set ssr = ActiveSelectionRange
  8. cnt = 1
  9. For Each s In ssr
  10. If cnt > 1 Then s.SetPosition ssr(cnt - 1).LeftX + ssr(cnt - 1).SizeWidth, ssr(cnt - 1).BottomY
  11. cnt = cnt + 1
  12. Next s
  13. End Sub
  14. ```
  15. ## 修改优化
  16. ```
  17. Sub 傻瓜火车排列()
  18. Dim ssr As ShapeRange, s As Shape
  19. Dim cnt As Integer
  20. Set ssr = ActiveSelectionRange
  21. cnt = 1
  22. ActiveDocument.ReferencePoint = cdrBottomLeft
  23. For Each s In ssr
  24. If cnt > 1 Then s.SetPosition ssr(cnt - 1).RightX, ssr(cnt - 1).BottomY
  25. cnt = cnt + 1
  26. Next s
  27. End Sub
  28. Sub 傻瓜阶梯排列()
  29. Dim ssr As ShapeRange, s As Shape
  30. Dim cnt As Integer
  31. Set ssr = ActiveSelectionRange
  32. cnt = 1
  33. ActiveDocument.ReferencePoint = cdrTopLeft
  34. For Each s In ssr
  35. If cnt > 1 Then s.SetPosition ssr(cnt - 1).LeftX, ssr(cnt - 1).BottomY
  36. cnt = cnt + 1
  37. Next s
  38. End Sub
  39. ```
  40. ### 从左到右排序
  41. ```
  42. Dim s As Shape
  43. Dim sr As ShapeRange
  44. ActiveDocument.Unit = cdrMillimeter
  45. Set sr = ActiveSelectionRange
  46. Dim i As Integer
  47. i = sr.count
  48. ' sr.sort " @shape1.Top * 100 - @shape1.Left > @shape2.Top * 100 - @shape2.Left"
  49. sr.sort " @shape1.top>@shape2.top"
  50. sr.sort " @shape1.left<@shape2.left"
  51. Dim j As Integer
  52. For j = 2 To i
  53. ' sr.Shapes.Item(j).TopY = sr.Shapes.Item(j - 1).TopY
  54. sr.Shapes.Item(j).LeftX = sr.Shapes.Item(j - 1).RightX + TextBox63
  55. Next
  56. ```