1
1

SelectLine_to_Cropline.bas 1.7 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061
  1. '// 单线条转裁切线 - 放置到页面四边
  2. Sub SelectLine_to_Cropline()
  3. '// 代码运行时关闭窗口刷新
  4. Application.Optimization = True
  5. ActiveDocument.Unit = cdrMillimeter
  6. ActiveDocument.BeginCommandGroup '一步撤消'
  7. '// 获得页面中心点 x,y
  8. px = ActiveDocument.Pages.First.CenterX
  9. py = ActiveDocument.Pages.First.CenterY
  10. Bleed = 2
  11. line_len = 3
  12. Dim s As Shape
  13. Dim line As Shape
  14. '// 遍历选择的线条
  15. For Each s In ActiveSelection.Shapes
  16. lx = s.LeftX
  17. rx = s.RightX
  18. by = s.BottomY
  19. ty = s.TopY
  20. cx = s.CenterX
  21. cy = s.CenterY
  22. sw = s.SizeWidth
  23. sh = s.SizeHeight
  24. '// 判断横线(高度小于宽度),在页面左边还是右边
  25. If sh <= sw Then
  26. s.Delete
  27. If cx < px Then
  28. Set line = ActiveLayer.CreateLineSegment(0, cy, 0 + line_len, cy)
  29. Else
  30. Set line = ActiveLayer.CreateLineSegment(px * 2, cy, px * 2 - line_len, cy)
  31. End If
  32. End If
  33. '// 判断竖线(高度大于宽度),在页面下边还是上边
  34. If sh > sw Then
  35. s.Delete
  36. If cy < py Then
  37. Set line = ActiveLayer.CreateLineSegment(cx, 0, cx, 0 + line_len)
  38. Else
  39. Set line = ActiveLayer.CreateLineSegment(cx, py * 2, cx, py * 2 - line_len)
  40. End If
  41. End If
  42. line.Outline.SetProperties 0.1
  43. line.Outline.SetProperties Color:=CreateRegistrationColor
  44. Next s
  45. ActiveDocument.EndCommandGroup
  46. '// 代码操作结束恢复窗口刷新
  47. Application.Optimization = False
  48. ActiveWindow.Refresh
  49. Application.Refresh
  50. End Sub