View Single Post
Old 21-10-2012, 00:13
shelbym's Avatar
shelbym shelbym is offline
Senior Member
Join Date: Nov 2002
Location: Cheyenne, WY
Posts: 1,769
Blog Entries: 9
Send a message via ICQ to shelbym Send a message via AIM to shelbym Send a message via MSN to shelbym Send a message via Yahoo to shelbym
Default Keeping Dashes

This one really made me think, but I think I have a better way. Basically, I make a copy of the line, then convert the original outline to curves, then create an intersection of the two. Copy the outline thickness and color to the new intersection and delete the original. Here is the code:
Sub KeepDashes()
    Dim sOriginal As Shape, sDup As Shape, sNewLine As Shape
    Dim dblOutlineWidth As Double
    Dim colOutline As New Color

    Set sOriginal = ActiveShape 'Get the selected shape
    dblOutlineWidth = sOriginal.Outline.Width 'Copy the line thickness
    colOutline.CopyAssign sOriginal.Outline.Color 'Copy the line color
    Set sDup = sOriginal.Duplicate 'Create a duplicate of the original
    sDup.Outline.SetNoOutline 'Remove the outline
    If sDup.Type <> cdrCurveShape Then sDup.ConvertToCurves
    If sDup.Curve.Closed Then sDup.Curve.Nodes.First.BreakApart

    Set sOriginal = sOriginal.Outline.ConvertToObject 'Convert the orginal outline to a curve
    Set sNewLine = sOriginal.Intersect(sDup)

    sNewLine.Outline.Width = dblOutlineWidth 'Apply the saved width
    sNewLine.Outline.Color.CopyAssign colOutline 'Apply the saved color
    'Clean up
    Set sNewLine = Nothing
End Sub
Hopefully it truly is a better way. :-)


Last edited by shelbym; 21-10-2012 at 00:26. Reason: Wasn't working correctly for closed shape
Reply With Quote