Is there a cleaner way to do this code? It's merely an Inner contour, copy and assigning original color and deleted previous. Basically like it's shaving off the thickness of an object. I mean it works wonderfully but im not satisfied. It's a little slow. 'shave thickness Dim sr As ShapeRange Dim s As Shape Dim e As Effect Dim col As New Color Set sr = ActiveSelectionRange If sr Is Nothing Then Exit Sub Set s = ActiveShape If s Is Nothing Then Exit Sub Optimization = True For Each s In sr.Shapes If s.Fill.Type = cdrUniformFill Then col.CopyAssign s.Fill.UniformColor On Error Resume Next Set e = s.CreateContour(cdrContourInside, 0.003, 1, 0, CreateCMYKColor(0, 0, 0, 100), CreateRGBColor(135, 211, 0), _ CreateCMYKColor(0, 0, 0, 100), 0, 0, 1, 5, 15#) e.Contour.ContourGroup.AddToSelection Set sr = e.Separate sr.Shapes.Last.Delete sr.Shapes.First.Fill.ApplyUniformFill col sr.Shapes.First.CreateSelection Next s Optimization = False
↧