Evaluate Curves Defined in Sketch Space Example (VBA)
This example shows how to evaluate curves that were defined in the space
of a sketch.
'----------------------------------------------
Option Explicit
' Define two types
Type DoubleRec
dValue
As Double
End Type
Type Long2Rec
iLower
As Long
iUpper
As Long
End Type
' Extract two integer values from a single double value
' by assigning a DoubleRec to the double value and then
' copying the value to Long2Rec and
' extracting the integer values
Function ExtractFields _
( _
ByVal
dValue As Double, _
iLower
As Long, _
iUpper
As Long _
)
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 ProcessCurve _
( _
swApp
As SldWorks.SldWorks, _
swModel
As SldWorks.ModelDoc2, _
swSketch
As SldWorks.sketch, _
swCurve
As SldWorks.Curve _
)
Dim
swMathUtil As
SldWorks.MathUtility
Dim
swXform As
SldWorks.MathTransform
Dim
nStartParam As
Double
Dim
nEndParam As
Double
Dim
bIsClosed As
Boolean
Dim
bIsPeriodic As
Boolean
Dim
vStartEval As
Variant
Dim
vEndEval As
Variant
Dim
nSuccessStart As
Long
Dim
nEndStart As
Long
Dim
nDummy As
Long
Dim
nStartPt(2) As
Double
Dim
vStartPt As
Variant
Dim
swStartPt As
SldWorks.MathPoint
Dim
nStartTanPt(2) As
Double
Dim
vStartTanPt As
Variant
Dim
swStartTanPt As
SldWorks.MathPoint
Dim
nEndPt(2) As
Double
Dim
vEndPt As
Variant
Dim
swEndPt As
SldWorks.MathPoint
Dim
nEndTanPt(2) As
Double
Dim
vEndTanPt As
Variant
Dim
swEndTanPt As
SldWorks.MathPoint
Dim
bRet As
Boolean
Set
swMathUtil = swApp.GetMathUtility
Set
swXform = swSketch.ModelToSketchTransform
Set
swXform = swXform.Inverse
bRet
= swCurve.GetEndParams(nStartParam,
nEndParam, bIsClosed, bIsPeriodic): Debug.Assert bRet
vStartEval
= swCurve.Evaluate(nStartParam)
vEndEval
= swCurve.Evaluate(nEndParam)
ExtractFields
vStartEval(6), nSuccessStart, nDummy
ExtractFields
vEndEval(6), nEndStart, nDummy
nStartPt(0)
= vStartEval(0): nStartPt(1)
= vStartEval(1): nStartPt(2)
= vStartEval(2)
vStartPt
= nStartPt
Set
swStartPt = swMathUtil.CreatePoint((vStartPt))
Set
swStartPt = swStartPt.MultiplyTransform(swXform)
nStartTanPt(0)
= vStartEval(3): nStartTanPt(1)
= vStartEval(4): nStartTanPt(2)
= vStartEval(5)
vStartTanPt
= nStartTanPt
Set
swStartTanPt = swMathUtil.CreatePoint((vStartTanPt))
Set
swStartTanPt = swStartPt.MultiplyTransform(swXform)
nEndPt(0)
= vEndEval(0): nEndPt(1)
= vEndEval(1): nEndPt(2)
= vEndEval(2)
vEndPt
= nEndPt
Set
swEndPt = swMathUtil.CreatePoint((vEndPt))
Set
swEndPt = swEndPt.MultiplyTransform(swXform)
nEndTanPt(0)
= vEndEval(3): nEndTanPt(1)
= vEndEval(4): nEndTanPt(2)
= vEndEval(5)
vEndTanPt
= nEndTanPt
Set
swEndTanPt = swMathUtil.CreatePoint((vEndTanPt))
Set
swEndTanPt = swEndPt.MultiplyTransform(swXform)
Debug.Print
"IsClosed =
" & bIsClosed
Debug.Print
"IsPeriodic =
" & bIsPeriodic
Debug.Print
""
Debug.Print
"Start (sketch)"
Debug.Print
" Point
=
(" & vStartEval(0) * 1000# & ", " & vStartEval(1)
* 1000# & ", " & vStartEval(2) * 1000# & ")
mm"
Debug.Print
" Tangent
=
(" & vStartEval(3) & ", " & vStartEval(4) &
", " & vStartEval(5) & ")"
Debug.Print
" Success
=
" & nSuccessStart
Debug.Print
"Finish (sketch)"
Debug.Print
" Point
=
(" & vEndEval(0) * 1000# & ", " & vEndEval(1)
* 1000# & ", " & vEndEval(2) * 1000# & ") mm"
Debug.Print
" Tangent
=
(" & vEndEval(3) & ", " & vEndEval(4) &
", " & vEndEval(5) & ")"
Debug.Print
" Success
=
" & nEndStart
Debug.Print
"Start (model)"
Debug.Print
" Point
=
(" & swStartPt.ArrayData(0)
* 1000# & ", " & swStartPt.ArrayData(1)
* 1000# & ", " & swStartPt.ArrayData(2)
* 1000# & ") mm"
Debug.Print
" Tangent
=
(" & swStartTanPt.ArrayData(0)
& ", " & swStartTanPt.ArrayData(1)
& ", " & swStartTanPt.ArrayData(2)
& ")"
Debug.Print
"Finish (model)"
Debug.Print
" Point
=
(" & swEndPt.ArrayData(0)
* 1000# & ", " & swEndPt.ArrayData(1)
* 1000# & ", " & swEndPt.ArrayData(2)
* 1000# & ") mm"
Debug.Print
" Tangent
=
(" & swEndTanPt.ArrayData(0)
& ", " & swEndTanPt.ArrayData(1)
& ", " & swEndTanPt.ArrayData(2)
& ")"
End Sub
Sub main()
Dim
swApp As
SldWorks.SldWorks
Dim
swModel As
SldWorks.ModelDoc2
Dim
swSelMgr As
SldWorks.SelectionMgr
Dim
swSkSeg As
SldWorks.SketchSegment
Dim
swSketch As
SldWorks.sketch
Dim
swCurve As
SldWorks.Curve
Set
swApp = Application.SldWorks
Set
swModel = swApp.ActiveDoc
Set
swSelMgr = swModel.SelectionManager
Set
swSkSeg = swSelMgr.GetSelectedObject5(1)
Set
swSketch = swSkSeg.GetSketch
Set
swCurve = swSkSeg.GetCurve
ProcessCurve
swApp, swModel, swSketch, swCurve
End Sub
'---------------------------------------------