使用SOLIDWORKS API在选定边上创建草图点
该宏使用SOLIDWORKS API在3D草图中的选定边上创建指定数量的草图点。
- 打开一个SOLIDWORKS零件。
- (可选) 打开一个3D草图以在现有草图中插入点,否则将创建一个新的草图。
- 运行该宏。输入要生成的点的数量。
{ width=320 height=239 }
结果将是在3D草图中生成的指定数量的草图点:
{ width=320 height=204 }
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swSelMgr As SldWorks.SelectionMgr
Sub main()
On Error Resume Next
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swSelMgr = swModel.SelectionManager
Dim isSketchActive As Boolean
isSketchActive = Not swModel.SketchManager.ActiveSketch Is Nothing
If isSketchActive Then
If Not swModel.SketchManager.ActiveSketch.Is3D Then
MsgBox "只能将点插入到3D草图中"
End
End If
End If
Dim swEdge As SldWorks.Edge
Set swEdge = swSelMgr.GetSelectedObject6(1, -1)
If Not swEdge Is Nothing Then
Dim swCurve As SldWorks.Curve
Set swCurve = swEdge.GetCurve
Dim vPts As Variant
Dim pointsCount As Integer
pointsCount = CInt(InputBox("指定点的数量"))
If pointsCount <= 0 Then
MsgBox "请指定一个大于1的有效整数"
End
End If
vPts = SplitCurveByPoints(swCurve, pointsCount)
swModel.ClearSelection2 True
If Not isSketchActive Then '打开一个新的3D草图
swModel.SketchManager.Insert3DSketch True
End If
Dim i As Integer
For i = 0 To (UBound(vPts) + 1) / 3 - 1
swModel.SketchManager.CreatePoint vPts(i * 3), vPts(i * 3 + 1), vPts(i * 3 + 2)
Next
If Not isSketchActive Then '仅在初始未打开草图时关闭草图
swModel.SketchManager.Insert3DSketch True
End If
Else
MsgBox "请选择一个边"
End If
End Sub
Function SplitCurveByPoints(swCurve As SldWorks.Curve, pointsNumber As Integer) As Variant
Dim nStartParam As Double
Dim nEndParam As Double
Dim bIsClosed As Boolean
Dim bIsPeriodic As Boolean
Dim incr As Double
Dim i As Integer
Dim vParam As Variant
Dim retVal() As Double
ReDim retVal(pointsNumber * 3 - 1)
swCurve.GetEndParams nStartParam, nEndParam, bIsClosed, bIsPeriodic
incr = (nEndParam - nStartParam) / (pointsNumber - 1)
For i = 0 To pointsNumber - 1
vParam = swCurve.Evaluate(nStartParam + i * incr)
retVal(i * 3) = vParam(0)
retVal(i * 3 + 1) = vParam(1)
retVal(i * 3 + 2) = vParam(2)
Next
SplitCurveByPoints = retVal
End Function
或者,可以根据曲线的近似长度创建点。以下示例通过计算曲线的近似长度来创建点:
Function SplitCurveByLength(swCurve As SldWorks.Curve, chordLength As Double) As Variant
Dim nStartParam As Double
Dim nEndParam As Double
Dim bIsClosed As Boolean
Dim bIsPeriodic As Boolean
swCurve.GetEndParams nStartParam, nEndParam, bIsClosed, bIsPeriodic
SplitCurveByLength = swCurve.GetTessPts(0.01, chordLength, swCurve.Evaluate2(nStartParam, 1), swCurve.Evaluate2(nEndParam, 1))
End Function
或者,可以根据曲线的总长度创建点:
Function SplitCurveByChord(swCurve As SldWorks.Curve, chordLength As Double) As Variant
Dim swCurveSpline As SldWorks.Curve
Dim nStartParam As Double
Dim nEndParam As Double
Dim bIsClosed As Boolean
Dim bIsPeriodic As Boolean
Dim incr As Double
Dim i As Integer
Dim vParam As Variant
Dim retVal() As Double
swCurve.GetEndParams nStartParam, nEndParam, bIsClosed, bIsPeriodic
Dim curveLength As Double
curveLength = swCurve.GetLength3(nStartParam, nEndParam)
ReDim retVal(CInt(curveLength / chordLength) * 3 - 1)
incr = (nEndParam - nStartParam) / (curveLength / chordLength)
For i = 0 To (UBound(retVal) + 1) / 3 - 1
vParam = swCurve.Evaluate2(nStartParam + i * incr, 1)
retVal(i * 3) = vParam(0)
retVal(i * 3 + 1) = vParam(1)
retVal(i * 3 + 2) = vParam(2)
Next
SplitCurveByChord = retVal
End Function