View Single Post
  #2  
Old 28-09-2014, 23:29
shelbym's Avatar
shelbym shelbym is offline
Senior Member
 
Join Date: Nov 2002
Location: Cheyenne, WY
Posts: 1,790
Blog Entries: 13
Send a message via ICQ to shelbym Send a message via AIM to shelbym Send a message via MSN to shelbym Send a message via Yahoo to shelbym
Default 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
Reply With Quote