Get Curve Spline Points Example (VBA)
Given a spline curve, this example shows how to get the set of interpolation
points.
'------------------------------------------------------------
' Extract two integer values out of a single double value,
assuming that a C int has 4 bytes
Type DoubleRec
dValue As Double
End Type
Type Int2Rec
iLower As Long
iUpper As Long
End Type
' Extract two integer values out of a single double value,
by assigning a DoubleRec to the double value then copying the value over
an Int2Rec and extracting the integer values
Function ExtractFields(dValue
As Double, iLower As Integer, iUpper As Integer)
Dim dr As DoubleRec
Dim i2r As Int2Rec
' Set the double value
dr.dValue = dValue
' Copy the values
LSet i2r = dr
' Extract the values
iLower = i2r.iLower
iUpper = i2r.iUpper
End Function
Sub Curve_GetSplinePts1()
' Active PartDoc should contain a selected SketchSegment
Dim swApp As Object
Dim Part As Object
Set swApp = CreateObject("SldWorks.Application")
Set Part = swApp.ActiveDoc
Dim swSelectMgr As Object
Set swSelectMgr = Part.SelectionManager
Dim swSketchSeg As Object
Set swSketchSeg = swSelectMgr.GetSelectedObject5(1)
Dim swCurveIn As Object
Set swCurveIn = swSketchSeg.GetCurve
Dim varSplineParams As Variant
' False - do not want a cubic spline
varSplineParams = swCurveIn.GetBCurveParams(False)
Dim iNumKnots As Integer
Dim iNumCtrlPts As Integer
Dim iDimension As Integer
Dim iOrder As Integer
Dim iPeriodicity As Integer
Dim iSplineArraySize As Integer
Dim dTmpValue1 As Double, dTmpValue2
As Double
Dim iSplineIndex As Integer
Dim iVarIndex As Integer
dTmpValue1 = varSplineParams(0)
ExtractFields dTmpValue1, iDimension,
iOrder
dTmpValue2 = varSplineParams(1)
ExtractFields dTmpValue2, iNumCtrlPts,
iPeriodicity
iNumKnots = iOrder + iNumCtrlPts
iSplineArraySize = 2 + iNumKnots
+ (iDimension * iNumCtrlPts)
Dim dSplineParams() As Double
ReDim dSplineParams(iSplineArraySize
- 1)
' Set Property Array
dSplineParams(0) = dTmpValue1
dSplineParams(1) = dTmpValue2
' Set Knot Vector
iSplineIndex = 2
iVarIndex = 2
For i = 0 To (iNumKnots - 1)
dSplineParams(iSplineIndex)
= varSplineParams(iVarIndex)
iSplineIndex = iSplineIndex
+ 1
iVarIndex = iVarIndex + 1
Next i
' Set Control Point Vector
For i = 0 To (iNumCtrlPts -
1)
For j = 1 To iDimension
dSplineParams(iSplineIndex)
= varSplineParams(iVarIndex)
iSplineIndex = iSplineIndex
+ 1
iVarIndex = iVarIndex + 1
Next j
Next i
Dim varSplinePtParams As Variant
varSplinePtParams = dSplineParams
Dim varSplinePts As Variant
varSplinePts = swCurveIn.GetSplinePts((varSplinePtParams))
End Sub
Sub Curve_GetSplinePts2()
' Active PartDoc should contain a selected SketchSegment
Dim swApp As Object
Dim Part As Object
Set swApp = CreateObject("SldWorks.Application")
Set Part = swApp.ActiveDoc
Dim swSelectMgr As Object
Set swSelectMgr = Part.SelectionManager
Dim swSketchSeg As Object
Set swSketchSeg = swSelectMgr.GetSelectedObject3(1)
Dim swCurveIn As Object
Set swCurveIn = swSketchSeg.GetCurve
Dim varSplineParams As Variant
' False - do not want a cubic spline
varSplineParams = swCurveIn.GetBCurveParams(False)
Dim varSplinePts As Variant
varSplinePts = swCurveIn.GetSplinePts((varSplineParams))
End Sub