Get Length of Spline or Elliptical Edge Example (VBA)
This example shows how to get the length of an edge using display tessellation.
'------------------------------------------------
'
' Preconditions:
' (1)
Part or assembly is open.
' (2)
Spline or elliptical edge is selected.
'
' Postconditions:
' (1)
Two 3D sketches are created: Control
Pts and Spline Pts.
' (2)
Control Pts contains control points
for the edge.
' (3)
Spline Pts contains spline points
for the edge.
'
' NOTE: Sketch
with spline points is only created for a spline edge.
'
'------------------------------------------------
Option Explicit
' Tolerances
that the user can set using Modeler::SetTolerances
Public Enum swTolerances_e
swBSCurveOutputTol
= 0 ' 3D
bspline curve output tolerance (meters)
swBSCurveNonRationalOutputTol
= 1 ' 3D
non-rational bspline curve output tolerance (meters)
swUVCurveOutputTol
= 2 ' 2D
trim curve output tolerance (fraction of characteristic min. face dimension)
swSurfChordTessellationTol
= 3 ' Chord
tolerance or deviation for tessellation for surfaces
swSurfAngularTessellationTol
= 4 ' Angular
tolerance or deviation for tessellation for surfaces
swCurveChordTessellationTol
= 5 ' Chord
tolerance or deviation for tessellation for curves
End Enum
Public Enum swCurveTypes_e
LINE_TYPE
= 3001
CIRCLE_TYPE
= 3002
ELLIPSE_TYPE
= 3003
INTERSECTION_TYPE
= 3004
BCURVE_TYPE
= 3005
SPCURVE_TYPE
= 3006
CONSTPARAM_TYPE
= 3008
TRIMMED_TYPE
= 3009
End Enum
' Define two types
Type DoubleRec
dValue
As Double
End Type
Type Long2Rec
iLower
As Long ' Assuming that a C int 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 and then
' 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 ProcessModellerSettings _
( _
swApp
As SldWorks.SldWorks, _
swModel
As SldWorks.ModelDoc2, _
swModeller
As SldWorks.Modeler _
)
'
Process 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 ProcessBCurveInfo _
( _
swApp
As SldWorks.SldWorks, _
swModel
As SldWorks.ModelDoc2, _
vBCurveParam
As Variant _
)
Dim
nDim As
Integer
Dim
nOrder As
Integer
Dim
nCtrlPoints As
Integer
Dim
nPeriodicity As
Integer
Dim
nNumKnots As
Integer
Dim
swSketch As
SldWorks.sketch
Dim
swSkFeat As
SldWorks.feature
Dim
swSkPt As
SldWorks.SketchPoint
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
" Num
Ctrl Pts =
" & 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
""
swModel.Insert3DSketch2 False
swModel.SetAddToDB True
swModel.SetDisplayWhenAdded False
Set
swSketch = swModel.GetActiveSketch2
Set
swSkFeat = swSketch
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"
Set
swSkPt = swModel.CreatePoint2(vBCurveParam(i
+ 0), vBCurveParam(i + 1), vBCurveParam(i + 2))
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) & "]"
Set
swSkPt = swModel.CreatePoint2(vBCurveParam(i
+ 0), vBCurveParam(i + 1), vBCurveParam(i + 2))
Next
i
End
If
swModel.SetDisplayWhenAdded True
swModel.SetAddToDB False
swModel.Insert3DSketch2 True
swModel.ClearSelection2 True
swSkFeat.Name = "Control Pts"
End Sub
Sub ProcessSplineInfo _
( _
swApp
As SldWorks.SldWorks, _
swModel
As SldWorks.ModelDoc2, _
vSplinePts
As Variant _
)
Dim
swSketch As
SldWorks.sketch
Dim
swSkFeat As
SldWorks.feature
Dim
swSkPt As
SldWorks.SketchPoint
Dim
i As
Long
swModel.Insert3DSketch2 False
swModel.SetAddToDB True
swModel.SetDisplayWhenAdded False
Set
swSketch = swModel.GetActiveSketch2
Set
swSkFeat = swSketch
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"
Set
swSkPt = swModel.CreatePoint2(vSplinePts(i
+ 0), vSplinePts(i + 1), vSplinePts(i + 2))
Next
i
swModel.SetDisplayWhenAdded True
swModel.SetAddToDB False
swModel.Insert3DSketch2 True
swModel.ClearSelection2 True
swSkFeat.Name = "Spline Pts"
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: Debug.Assert
swCurve.IsBcurve
ProcessModellerSettings
swApp, swModel, swModeller
vBCurveParam
= swCurve.GetBCurveParams(False)
vSplinePts
= swCurve.GetSplinePts(vBCurveParam)
Debug.Print
"File = " & swModel.GetPathName
Debug.Print
" Identity
=
" & swCurve.Identity
ProcessBCurveInfo
swApp, swModel, vBCurveParam
Debug.Print
" -------------------------------------------"
'
Do not assert because NULL is a valid return value
'
Curve::GetSplinePts
'
*
If the
curve is periodic, it must not have any repeated knots.
'
*
If the
curve is non-periodic, it must only have repeated
'
knots
at its ends.
'
'
The
curve must be cubic or lower degree, non-rational, and
'
have
continuous first and second derivatives.
'
'
NOTE:
For a linear or quadratic curve to satisfy these continuity
'
requirements,
it must consist of a single segment.
'
If
Not IsNull(vSplinePts) Then
ProcessSplineInfo
swApp, swModel, vSplinePts
Debug.Print
" -------------------------------------------"
End
If
End Sub
'------------------------------------------------------