1
1

cropline.bas 2.0 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152
  1. ' Attribute VB_Name = "裁切线"
  2. Sub start()
  3. '// 代码运行时关闭窗口刷新
  4. Application.Optimization = True
  5. ActiveDocument.BeginCommandGroup '一步撤消'
  6. '// 设置当前文档 尺寸单位mm 出血和线长
  7. ActiveDocument.Unit = cdrMillimeter
  8. Bleed = 2
  9. line_len = 3
  10. Dim OrigSelection As ShapeRange
  11. Set OrigSelection = ActiveSelectionRange
  12. '// 定义当前选择物件 分别获得 左右下上中心坐标(x,y)和尺寸信息
  13. Dim s1 As Shape
  14. For Each Target In OrigSelection
  15. Set s1 = Target
  16. lx = s1.LeftX: rx = s1.RightX
  17. by = s1.BottomY: ty = s1.TopY
  18. cx = s1.CenterX: cy = s1.CenterY
  19. sw = s1.SizeWidth: sh = s1.SizeHeight
  20. '// 添加裁切线,分别左下-右下-左上-右上
  21. Dim s2, s3, s4, s5, s6, s7, s8, s9 As Shape
  22. Set s2 = ActiveLayer.CreateLineSegment(lx - Bleed, by, lx - (Bleed + line_len), by)
  23. Set s3 = ActiveLayer.CreateLineSegment(lx, by - Bleed, lx, by - (Bleed + line_len))
  24. Set s4 = ActiveLayer.CreateLineSegment(rx + Bleed, by, rx + (Bleed + line_len), by)
  25. Set s5 = ActiveLayer.CreateLineSegment(rx, by - Bleed, rx, by - (Bleed + line_len))
  26. Set s6 = ActiveLayer.CreateLineSegment(lx - Bleed, ty, lx - (Bleed + line_len), ty)
  27. Set s7 = ActiveLayer.CreateLineSegment(lx, ty + Bleed, lx, ty + (Bleed + line_len))
  28. Set s8 = ActiveLayer.CreateLineSegment(rx + Bleed, ty, rx + (Bleed + line_len), ty)
  29. Set s9 = ActiveLayer.CreateLineSegment(rx, ty + Bleed, rx, ty + (Bleed + line_len))
  30. '// 选中裁切线 群组 设置线宽和注册色
  31. ActiveDocument.AddToSelection s2, s3, s4, s5, s6, s7, s8, s9
  32. ActiveSelection.Group
  33. ActiveSelection.Outline.SetProperties 0.1
  34. ActiveSelection.Outline.SetProperties Color:=CreateRegistrationColor
  35. Next Target
  36. ActiveDocument.EndCommandGroup
  37. '// 代码操作结束恢复窗口刷新
  38. Application.Optimization = False
  39. ActiveWindow.Refresh
  40. Application.Refresh
  41. End Sub