Get Parameters and Spline Points for Curve Example (VBA)
This example shows how to get the parameters and spline points for the
selected spline.
'----------------------------------------
'
' Preconditions: Model document is open and a spline is
selected.
'
' Postconditions: None
'
'-----------------------------------------
Option Explicit
' Define two types
Type DoubleRec
dValue
As Double
End Type
Type Long2Rec
iLower
As Long ' Assuming that a C integer has 4 bytes
iUpper
As Long
End Type
' Extract two integer values out of a single double value
' by assigning a DoubleRec to the double value,
' copying the value over an Long2Rec, and
' extracting the integer values
Function ExtractFields(ByVal dValue As Double, iLower
As Integer, iUpper As Integer)
Dim
dr As
DoubleRec
Dim
i2r As
Long2Rec
'
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 DumpModellerSettings _
( _
swModeller
As SldWorks.Modeler _
)
'
Dump modeller settings
Debug.Print
"Modeller Settings:"
Debug.Print
" BSCurveOutputTol
=
" & swModeller.GetToleranceValue(swBSCurveOutputTol)
Debug.Print
" BSCurveNonRationalOutputTol
=
" & swModeller.GetToleranceValue(swBSCurveNonRationalOutputTol)
Debug.Print
" UVCurveOutputTol
=
" & swModeller.GetToleranceValue(swUVCurveOutputTol)
Debug.Print
" SurfChordTessellationTol
=
" & swModeller.GetToleranceValue(swSurfChordTessellationTol)
Debug.Print
" SurfAngularTessellationTol
=
" & swModeller.GetToleranceValue(swSurfAngularTessellationTol)
Debug.Print
" CurveChordTessellationTol
=
" & swModeller.GetToleranceValue(swCurveChordTessellationTol)
Debug.Print
""
End Sub
Sub DumpBCurveInfo _
( _
vBCurveParam
As Variant _
)
Dim
nDim As
Integer
Dim
nOrder As
Integer
Dim
nCtrlPoints As
Integer
Dim
nPeriodicity As
Integer
Dim
nNumKnots As
Integer
Dim
i As
Integer
ExtractFields
vBCurveParam(0), nDim, nOrder
ExtractFields
vBCurveParam(1), nCtrlPoints, nPeriodicity
nNumKnots
= nOrder + nCtrlPoints
Debug.Print
" Dimension
=
" & nDim
Debug.Print
" Order
=
" & nOrder
Debug.Print
" Number
Control Points =
" & nCtrlPoints
Debug.Print
" Periodicity
=
" & nPeriodicity
Debug.Print
" Num
Knots =
" & nNumKnots
Debug.Print
""
For
i = 0 To nNumKnots - 1
'
Knot weights should be increasing monotonically
Debug.Print
" Knot("
& i & ") =
" & vBCurveParam(2 + i)
Next
i
Debug.Print
""
If
3 = nDim Then
For
i = 2 + nNumKnots To UBound(vBCurveParam) - 1 Step 3
Debug.Print
" Ctrl("
& (i - 2 - nNumKnots) / 3 & ") =
(" & _
vBCurveParam(i
+ 0) * 1000# & ", " & _
vBCurveParam(i
+ 1) * 1000# & ", " & _
vBCurveParam(i
+ 2) * 1000# & ") mm"
Next
i
Else
For
i = 2 + nNumKnots To UBound(vBCurveParam) - 1 Step 4
Debug.Print
" Ctrl("
& (i - 2 - nNumKnots) / 4 & ") =
(" & _
vBCurveParam(i
+ 0) * 1000# & ", " & _
vBCurveParam(i
+ 1) * 1000# & ", " & _
vBCurveParam(i
+ 2) * 1000# & ") mm [" & _
vBCurveParam(i
+ 3) & "]"
Next
i
End
If
End Sub
Sub DumpSplineInfo _
( _
vSplinePts
As Variant _
)
Dim
i As
Long
For
i = 0 To UBound(vSplinePts) Step 3
Debug.Print
" SplinePt("
& i / 3 & ") =
(" & vSplinePts(i + 0) * 1000# & ", " & vSplinePts(i
+ 1) * 1000# & ", " & vSplinePts(i + 2) * 1000# &
") mm"
Next
i
End Sub
Sub main()
Dim
swApp As
SldWorks.SldWorks
Dim
swModeller As
SldWorks.Modeler
Dim
swModel As
SldWorks.ModelDoc2
Dim
swSelMgr As
SldWorks.SelectionMgr
Dim
swEdge As
SldWorks.Edge
Dim
swCurve As
SldWorks.Curve
Dim
vBCurveParam As
Variant
Dim
vSplinePts As
Variant
Dim
i As
Long
Dim
bRet As
Boolean
Set
swApp = Application.SldWorks
Set
swModeller = swApp.GetModeler
Set
swModel = swApp.ActiveDoc
Set
swSelMgr = swModel.SelectionManager
Set
swEdge = swSelMgr.GetSelectedObject5(1)
Set
swCurve = swEdge.GetCurve
DumpModellerSettings
swModeller
vBCurveParam
= swCurve.GetBCurveParams(False)
vSplinePts
= swCurve.GetSplinePts(vBCurveParam)
Debug.Print
"File = " & swModel.GetPathName
DumpBCurveInfo
vBCurveParam
Debug.Print
" -------------------------------------------"
Debug.Assert
Not IsNull(vSplinePts)
DumpSplineInfo
vSplinePts
Debug.Print
" -------------------------------------------"
End Sub