#1




Dividing curves in centimeters
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 
#2




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: Code:
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 Code:
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, " tenthmicrons", _ " 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 Someone please help me? continue to test to see if I get a greeting thanks 
#3




I found this code that creates a line perpendicular, but is a bit complicated for me.
Code:
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 thanks in advance a greeting 
#4




This code calculates the perimeter of a curve, and it is basicaly what i need.
Code:
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, " tenthmicrons", _ " 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 Is it hard to get? I couldn't so far Could anyone of you help me? Thanx 
Currently Active Users Viewing This Thread: 1 (0 members and 1 guests)  
Thread Tools  Search this Thread 
Display Modes  


Similar Threads  
Thread  Thread Starter  Forum  Replies  Last Post 
connect curves: arc curves  TobWen  CurveWorks  4  30052008 12:47 
dividing a curve into fixed distances between nodes  Jeff Harrison  CorelDRAW/Corel DESIGNER VBA  0  05092007 03:17 
A better curves dialogue...  akayani  CorelDRAW/Corel DESIGNER VBA  1  28032006 16:54 
[NewbieQ] All Curves plz  Booker  CorelDRAW/Corel DESIGNER VBA  4  12122005 17:44 
[b]Smoothing curves[/b]  LOT  CorelDRAW/Corel DESIGNER VBA  2  11022004 08:24 