Thread: Virtual shape and speed up View Single Post
#2
28-09-2014, 23:29
 shelbym Senior Member Join Date: Nov 2002 Location: Cheyenne, WY Posts: 1,790 Blog Entries: 13
Virtual Curves and Shapes

This should get you started:
Code:
```Sub CreateMyVirtualCurve()
Dim s As Shape, crv As Curve
Dim x As Double, y As Double
Dim arrPoints(9, 1) As Double

arrPoints(0, 0) = 162.4175222: arrPoints(0, 1) = 0.750376435
arrPoints(1, 0) = 162.1904178: arrPoints(1, 1) = 1.42190801
arrPoints(2, 0) = 161.8497645: arrPoints(2, 1) = 1.948110991
arrPoints(3, 0) = 161.4460634: arrPoints(3, 1) = 2.285272734
arrPoints(4, 0) = 161.0384773: arrPoints(4, 1) = 2.41926736
arrPoints(5, 0) = 160.6855104: arrPoints(5, 1) = 2.367701481
arrPoints(6, 0) = 160.4357975: arrPoints(6, 1) = 2.177051589
arrPoints(7, 0) = 160.3204565: arrPoints(7, 1) = 1.915245416
arrPoints(8, 0) = 160.3482122: arrPoints(8, 1) = 1.66085887
arrPoints(9, 0) = 160.5040603: arrPoints(9, 1) = 1.490634456

x = arrPoints(0, 0)
y = arrPoints(0, 1)

Set crv = New Curve 'Create our curve in Memory
Set sp = crv.CreateSubPath(x, y)

For i = 1 To 9
x = arrPoints(i, 0)
y = arrPoints(i, 1)
sp.AppendCurveSegment x, y
Next i

sp.Closed = False

'Take our curve in memory and create a virtual shape
Set s = ActiveVirtualLayer.CreateCurve(crv)

'Smooth all the nodes
s.Curve.Nodes.All.SetType cdrSmoothNode

'Log the newly created virual shape
ActiveDocument.LogCreateShape s
End Sub```
Also, just for fun. In X7 there is a much easier way to do this:
Code:
```Sub CreateMyVirtualCurveX7()
Dim s As Shape, crv As Curve
Dim pr As New PointRange
Dim arrPoints(9, 1) As Double

arrPoints(0, 0) = 162.4175222: arrPoints(0, 1) = 0.750376435
arrPoints(1, 0) = 162.1904178: arrPoints(1, 1) = 1.42190801
arrPoints(2, 0) = 161.8497645: arrPoints(2, 1) = 1.948110991
arrPoints(3, 0) = 161.4460634: arrPoints(3, 1) = 2.285272734
arrPoints(4, 0) = 161.0384773: arrPoints(4, 1) = 2.41926736
arrPoints(5, 0) = 160.6855104: arrPoints(5, 1) = 2.367701481
arrPoints(6, 0) = 160.4357975: arrPoints(6, 1) = 2.177051589
arrPoints(7, 0) = 160.3204565: arrPoints(7, 1) = 1.915245416
arrPoints(8, 0) = 160.3482122: arrPoints(8, 1) = 1.66085887
arrPoints(9, 0) = 160.5040603: arrPoints(9, 1) = 1.490634456

For i = 0 To 9
pr.AddPointXY arrPoints(i, 0), arrPoints(i, 1)
Next i

Set crv = ActiveDocument.CreateCurveFitToPoints(pr)
'Or you can set a tolerance
'Set crv = ActiveDocument.CreateCurveFitToPoints(pr, False, .01)

Set s = ActiveVirtualLayer.CreateCurve(crv)

ActiveDocument.LogCreateShape s
End Sub```
Hope that helps,

-Shelby