Is there an Equiv to AI Divide Tool? If not...

If not - what is the best way to replicate that tool?

I attempted myself but I cannot tell what it's doing exactly to replicate it in VBA.  It sort of looks like its trimming & intersecting but not really. It's kind of hard to decipher. In any event I need a tool similar... Is there a post for this by chance or anyone who can help? 

IF there isnt. Is there a post or someone who can help with a node function similar to inkscapes / extension/ add node function? It like evens out all the nodes along a curve with a value (and doesnt alter the shape). If not that's cool. The divide one im looking for as of now. 

Any help would be appreciated. 

  • What - exactly - are you trying to do?

  • your can mesure shape segments, store segments offset, add node in segment passing offset to don't deform shape curve, i don't write vba code, this post can help, check the Myron answer

  • Here is a macro that allows you to divide curves,and more. It has a small cost:

    http://macromonster.com/product/alexander-penkins-cadtool-5/

  • If the task is "divide a Curve into pieces of equal length" - and I admit that I don't know if that's exactly what you want to do - then you could look at this. It uses the approach that bonus630 described:

    Sub divide_curve(ByRef CurveShape As Shape, ByVal NumPieces As Long, ByVal BreakAtNodes As Boolean)
    
    Dim curveThis As Curve
    Dim dblPieceLengthTarget As Double
    Dim dblPieceLengthThis As Double
    Dim lngPieceCounter As Long
    Dim lngSegmentIndex As Long
    Dim segThis As Segment
    Dim nodeThis As Node
    
        On Error GoTo ErrHandler
        
        If CurveShape.Type = cdrCurveShape Then
    
            Set curveThis = CurveShape.Curve
            
            If curveThis.Closed Then
                curveThis.Nodes.First.BreakApart
            End If
            
            dblPieceLengthTarget = curveThis.Length / NumPieces
            
            For lngPieceCounter = 1 To NumPieces - 1
            
                dblPieceLengthThis = 0
                
                Do While dblPieceLengthThis < dblPieceLengthTarget
                    lngSegmentIndex = lngSegmentIndex + 1
                    Set segThis = curveThis.Segments(lngSegmentIndex)
                    dblPieceLengthThis = dblPieceLengthThis + segThis.Length
                Loop
                
                If dblPieceLengthThis = dblPieceLengthTarget Then
                    Set nodeThis = segThis.EndNode
                Else
                    Set nodeThis = segThis.AddNodeAt(dblPieceLengthTarget - (dblPieceLengthThis - segThis.Length), cdrAbsoluteSegmentOffset)
                End If
                
                If BreakAtNodes Then
                    nodeThis.BreakApart
                End If
            
            Next lngPieceCounter
            
        Else
            MsgBox "Shape is not a Curve."
        End If
        
    ExitSub:
        Exit Sub
    
    ErrHandler:
        MsgBox "Error occurred: " & Err.Description
        Resume ExitSub
    End Sub
    

    And here are a couple of subs to try that out:

    Sub test_divide_curve_break()
        
        On Error GoTo ErrHandler
        
        ActiveDocument.BeginCommandGroup "Divide Curve"
        EventsEnabled = False
        Optimization = True
        
        divide_curve ActiveShape, 10, True
        ActiveShape.BreakApart
        
        ActiveDocument.EndCommandGroup
        Optimization = False
        EventsEnabled = True
        Refresh
        
    ExitSub:
        Optimization = False
        EventsEnabled = True
        ActiveDocument.EndCommandGroup
        Refresh
        Exit Sub
    
    ErrHandler:
        MsgBox "Error occurred: " & Err.Description
        Resume ExitSub
    End Sub
    

    Sub test_divide_curve_nobreak()
        
        On Error GoTo ErrHandler
        
        ActiveDocument.BeginCommandGroup "Divide Curve"
        EventsEnabled = False
        Optimization = True
        
        divide_curve ActiveShape, 10, False
        
        ActiveDocument.EndCommandGroup
        Optimization = False
        EventsEnabled = True
        Refresh
        
    ExitSub:
        Optimization = False
        EventsEnabled = True
        ActiveDocument.EndCommandGroup
        Refresh
        Exit Sub
    
    ErrHandler:
        MsgBox "Error occurred: " & Err.Description
        Resume ExitSub
    End Sub
    

    .

    VIDEO: test divide curve

    That could perhaps be done slicker / better, but it might give you some ideas, and you can of course "make it your own" based on your particular needs.

  • I believe you are looking for this. Select your first shape, then shift select your second shape at you wish to divide. Run the code and hopefully that is the result you are looking for. 

    Sub DivideTool()
        Dim s As Shape
        Dim sr As ShapeRange
        
        Set sr = ActiveSelectionRange
        Set s = sr(2).Trim(sr(1), False, False)
        s.BreakApart
    End Sub
    

    If it is, let me know and I can add a single undo for the process.

    Happy coding, 

    -Shelby