OberonPlace.com Forums

OberonPlace.com Forums (http://forum.oberonplace.com/index.php)
-   CorelDRAW/Corel DESIGNER VBA (http://forum.oberonplace.com/forumdisplay.php?f=16)
-   -   Joining Subpaths (http://forum.oberonplace.com/showthread.php?t=24748)

nic 09-02-2016 14:39

Joining Subpaths
 
Hi
I have a drawing with 1,000 open curves with just two nodes per curve (at the ends) which when viewed normally seem to form one continuous (open) line. The end node of each curve being in the same x,y position as the start of the next and with the curves in z-order following the continuous line. The curves vary in linewidth with the next curve in the chain being either the same width or 0.1mm thinner or thicker (with most being the same as the one before and after).

The following macro correctly 'Combines' the 2 node curves based upon thickness of lines but ends up producing curves made up of many 2 node subpaths.

What do I need to do to produce curves where each curve is one thickness and only one subpath?

EDIT.
A. http://forum.oberonplace.com/showthread.php?t=8155

This is a question I had already asked and had answered.

sorry.


Thanks
nic

EDIT:
Code:

Set sr = ActiveLayer.Shapes.FindShapes()
For Each s In sr
s.CustomCommand "ConvertTo", "JoinCurves", 0.1
Next s

Code:

Sub JoinLines()
   
    Dim sh As Shape
    Dim sr As ShapeRange
    Dim srLine As New ShapeRange ' sr for final curve
 
    Dim w As Double ' line width

    Set sr = ActiveLayer.Shapes.FindShapes()
    Set srLine = Nothing
   
    'set width to check for at first
    w = sr(1).Outline.Width
 
    For Each s In sr

    'if line width is the one we are looking for - add to srLine
        If s.Outline.Width = w Then
            srLine.Add s
        End If

    'if NOT the same - combine the sr into a single shape, clear the sr and set thenew linewidth to look for and add the current shape to new sr
        If s.Outline.Width <> w Then
            'set the line width to the new size
            w = s.Outline.Width
            'set srLine to a single line
            srLine.Combine
            'clear the SrLine
            srLine.RemoveAll
            'add the new Shape with the new line thickness to just cleared shaperange
            srLine.Add s
        End If

    Next s
            'set the final srLine to a single line
            srLine.Combine

End Sub



All times are GMT -5. The time now is 11:13.

Powered by vBulletin® Version 3.8.1
Copyright ©2000 - 2022, Jelsoft Enterprises Ltd.
Copyright © 2011, Oberonplace.com