Dividing curves in centimeters

[buga]

Hello such.

You see, I like to make a code, but not where to begin.
I split a curve in centimeters. Perhaps adding nodes every inch. or adding a small line perpendicular to the curve every inch.
but ... How to follow the path of the line?

Could anyone please help me get started?

Thank you very much in advance.

a greeting

[buga]

Hello again.

I have been researching on how to make the code of this post, and I found a couple of very useful macros, which combined, could get the code that I would like to do.

This code divides the curve on the nodes you want:

Option Explicit

Public Sub curveDivider()
    Dim thisDoc As Document
    Dim theseShapes As Shapes
    Dim thisShape As Shape
    Dim thisSubPath As SubPath
    Dim thisSegment As Segment
    Dim shapeCount As Long
    Dim misshapeCount As Long
    Dim dividedSegmentCount As Long
    
    Set thisDoc = ActiveDocument
    Set theseShapes = ActiveSelection.Shapes
    
    dividedSegmentCount = CLng(InputBox("Enter the number of SEGMENTS that you want to divide " _
                            & "the selected curves into:", "IsoCalc Curve Divider", _
                            theseShapes(1).Curve.Subpaths(1).Segments.count))
                            
    If dividedSegmentCount = 0 Then
        MsgBox "You must enter a value of 1 or more.", vbExclamation, "IsoCalc Curve Divider Error"
        Exit Sub
    End If
    
    misshapeCount = 0
    For Each thisShape In theseShapes
        If thisShape.Type = cdrCurveShape Then
            For Each thisSubPath In thisShape.Curve.Subpaths
                If thisSubPath.Closed = True Then
                    If divideOpenSubPath(thisSubPath, dividedSegmentCount) = False Then
                        misshapeCount = misshapeCount + 1
                    End If
                Else
                    If divideOpenSubPath(thisSubPath, dividedSegmentCount) = False Then
                        misshapeCount = misshapeCount + 1
                    End If
                End If
            Next thisSubPath
        Else
            misshapeCount = misshapeCount + 1
        End If
    Next thisShape
End Sub

Private Function divideClosedSubPath(thisSubPath As SubPath, dividedSegmentCount As Long) As Boolean

End Function

Private Function divideOpenSubPath(thisSubPath As SubPath, dividedSegmentCount As Long) As Boolean
    Dim count As Long
    For count = dividedSegmentCount - 1 To 1 Step -1
        '(count) / dividedSegmentCount To 1 / dividedSegmentCount Step -1 / dividedSegmentCount
        thisSubPath.AddNodeAt count / dividedSegmentCount '(count / (count + 1))
    Next count
End Function

This code calculates the perimeter of a curve:

Public Sub measure_perimeter()
    Dim doc As Document, old_units As Long
    Dim sDupShape As Shape
    Dim length As String, shape_count As Long
    shape_count = ActiveSelection.Shapes.Count
    If shape_count > 0 Then
        'Set the document units to horizontal ruler units
        Set doc = ActiveDocument
        doc.BeginCommandGroup "IsoCalc.com's Perimeter temporary shapes"
        old_units = doc.Unit
        doc.Unit = doc.Rulers.HUnits
        'Get the length of the shape or shapes and tidy up
        ActiveSelection.Duplicate
        ActiveSelection.UngroupAll
        Set sDupShape = ActiveSelection.Combine
        length = (sDupShape.Curve.length * doc.WorldScale) & Choose(doc.Unit + 1, " tenth-microns", _
                    " inches", " feet", "mm", "cm", " pixels", " miles", "m", _
                    "km", " didots", " Agate", "yds", " pica", " cicero", "pt", _
                    "Q", "H")
        doc.EndCommandGroup
        doc.Undo
        doc.Unit = old_units
        'Report the length
        If shape_count = 1 Then
            MsgBox "The perimeter is " & length & ".", vbOKOnly, "IsoCalc.com's Perimeter"
        Else
            MsgBox "The sum perimeter of all " & shape_count & " shapes is " & length & ".", _
                    vbOKOnly, "IsoCalc.com's Perimeter"
        End If
    End If
End Sub

You see, I like to combine these codes, so as to calculate the perimeter of the curve to calculate the number of divisions of the curve. Adding a line perpendicular to each new node, oriented curve.

Someone please help me?

continue to test to see if I get

a greeting

thanks

[buga]

I found this code that creates a line perpendicular, but is a bit complicated for me.

Sub PerpendicularLine()
    Dim x As Double, y As Double
    Dim x0 As Double, y0 As Double, r As Double, n As Long, r0 As Double
    Dim dx As Double, dy As Double
    Dim a2 As Double
    Dim offs As Double
    
    Dim Shift As Long
    
    Dim s As Shape
    Dim sel As Shape
       
    Dim seg As Segment
    Dim seg0 As Segment
        
    If Documents.Count = 0 Then
        MsgBox "No document open.", vbCritical
        Exit Sub
    End If
    
    While ActiveDocument.GetUserClick(x, y, Shift, 1000, True, cdrCursorSmallcrosshair) = 0
        
        Set sel = ActiveDocument.ActivePage.SelectShapesAtPoint(x, y, False)

        If sel.Shapes.Count > 0 Then
            Set s = sel.Shapes(1)
       
            If s.Type = cdrCurveShape Then
            
                If s.IsOnShape(x, y) = cdrOnMarginOfShape Then
                    r = 1E+50
                    Set seg0 = Nothing
                    For Each seg In s.Curve.Segments
                        For n = 0 To 49
                            seg.GetPointPositionAt x0, y0, n / 50, cdrParamSegmentOffset
            
                            x0 = x0 - x
                            y0 = y0 - y
                            r0 = x0 * x0 + y0 * y0
                            If r0 < r Then
                                r = r0
                                Set seg0 = seg
                                offs = n / 50
                            End If
                        Next n
                    Next seg
        
                    a2 = seg0.GetPerpendicularAt(offs, cdrParamSegmentOffset) * 3.1415926 / 180
                    dx = 0.5 * Cos(a2)
                    dy = 0.5 * Sin(a2)
                    
                    With ActiveLayer.CreateLineSegment(x - dx / 2, y - dy / 2, x + dx / 2, y + dy / 2)
                        .Outline.EndArrow = ArrowHeads(1)
                    End With
                    
                    ActiveDocument.ClearSelection
                End If
            End If
        End If
    Wend
End Sub

Could someone help me simplify it, so that instead of creating lines where they click, they believe in each node automatically?

thanks in advance

a greeting

[mateushenrico]

This code calculates the perimeter of a curve, and it is basicaly what i need.

Public Sub measure_perimeter()
    Dim doc As Document, old_units As Long
    Dim sDupShape As Shape
    Dim length As String, shape_count As Long
    shape_count = ActiveSelection.Shapes.Count
    If shape_count > 0 Then
        'Set the document units to horizontal ruler units
        Set doc = ActiveDocument
        doc.BeginCommandGroup "IsoCalc.com's Perimeter temporary shapes"
        old_units = doc.Unit
        doc.Unit = doc.Rulers.HUnits
        'Get the length of the shape or shapes and tidy up
        ActiveSelection.Duplicate
        ActiveSelection.UngroupAll
        Set sDupShape = ActiveSelection.Combine
        length = (sDupShape.Curve.length * doc.WorldScale) & Choose(doc.Unit + 1, " tenth-microns", _
                    " inches", " feet", "mm", "cm", " pixels", " miles", "m", _
                    "km", " didots", " Agate", "yds", " pica", " cicero", "pt", _
                    "Q", "H")
        doc.EndCommandGroup
        doc.Undo
        doc.Unit = old_units
        'Report the length
        If shape_count = 1 Then
            MsgBox "The perimeter is " & length & ".", vbOKOnly, "IsoCalc.com's Perimeter"
        Else
            MsgBox "The sum perimeter of all " & shape_count & " shapes is " & length & ".", _
                    vbOKOnly, "IsoCalc.com's Perimeter"
        End If
    End If
End Sub

I've been trying to add another function: at the moment the script gets the perimeter of the active curve, it also adds a text, centered the shape, with the value of its perimeter.

Is it hard to get? I couldn't so far

Could anyone of you help me?

Thanx