CreateContour.bas 825 B

123456789101112131415161718192021
  1. Sub TestMacro()
  2. ActiveDocument.Unit = cdrMillimeter
  3. Dim sh As Shape, shs As Shapes, cs As Shape
  4. Set shs = ActiveSelection.Shapes
  5. For Each sh In shs
  6. Dim eff1 As Effect
  7. Set eff1 = sh.CreateContour(cdrContourOutside, 5, 1, cdrDirectFountainFillBlend, CreateRGBColor(26, 22, 35), CreateCMYKColor(0, 0, 0, 100), CreateCMYKColor(0, 0, 0, 100), 0, 0, cdrContourSquareCap, cdrContourCornerMiteredOffsetBevel, 15#)
  8. eff1.Contour.ContourGroup.Shapes(1).AddToSelection
  9. eff1.Separate
  10. Next sh
  11. Dim OrigSelection As ShapeRange
  12. Set OrigSelection = ActiveSelectionRange
  13. Set sh = OrigSelection.CustomCommand("Boundary", "CreateBoundary")
  14. ActiveSelection.Shapes.FindShapes(Query:="@Outline.Color=RGB(26, 22, 35)").CreateSelection
  15. For Each sh In ActiveSelection.Shapes
  16. sh.Delete
  17. Next sh
  18. End Sub