-
Re: Macro to divide selected segment with equalsegment
if the segment is selected then this will work, i didnt test it but it should
if you want it split into sketch points
Function SplitSegment(ByVal SplitCt As Integer) As Boolean
Dim Part As ModelDoc2
Dim swApp As SldWorks = Application.SldWorks
Set Part = swApp.ActiveDoc
Dim SelMgr As SelectionMgr
Set SelMgr = Part.SelectionManager
If SelMgr.GetSelectedObjectCount2(-1) = 1 Then
If SelMgr.GetSelectedObjectType3(1, -1) = swSelectType_e.swSelSKETCHSEGS Then
Dim SkSeg As SketchSegment
Set SkSeg = SelMgr.GetSelectedObject6(1, -1)
SplitSegment = SkSeg.EqualSegment(swSketchSegmentType_e.swSketchSegmentType_sketchpoints, SplitCt)
End If
End If
End Function
-
Re: Macro to divide selected segment with equalsegment
I am complete newbie when it comes to macros. Anyways, my goal is to split spline into number of points. I found one macro that does this very well, but the problem for me is that points that split the spline are "equally distanced" in terms of distance along the spline. As a result I get points, which are not equally distanced in terms of x coordinate which is what I want to do...
I have an idea to split x-axis into equally distanced points and then project them on the spline to get points which have the same "step" in x coordinate. But I just simply have no knowledge to execute this I don't even know if this is a good idea. Any help would be very helpful...
I attached image below for better understanding. Orange arrow is along the spline and is equally distanced but x1 does not equal to x2, which is my goal...
MACRO:
Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swSelMgr As SldWorks.SelectionMgr
Dim vFeatArr As Variant
Dim swFeatMgr As SldWorks.FeatureManager
Dim swModelDocExt As SldWorks.ModelDocExtension
Dim swSpline As SldWorks.SketchSpline
Dim vFeat As Variant
Dim swFeat As SldWorks.Feature
Dim swRefPt As SldWorks.RefPoint
Dim swRefPtData As SldWorks.RefPointFeatureData
Dim swMathPt As SldWorks.MathPoint
Dim swSkPt As SketchPoint
Dim swMgr As SketchManager
Dim nStatus As Long
Dim bRet As Boolean
Dim boolstatus As Boolean
Dim i As Long
Sub main()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swSelMgr = swModel.SelectionManager
Set swFeatMgr = swModel.FeatureManager
Set swModelDocExt = swModel.Extension
If Not swSelMgr.GetSelectedObjectType3(1, -1) = swSelEXTSKETCHSEGS Then
MsgBox "select spline"
Exit Sub
End If
Dim Spline As Object
Set Spline = swSelMgr.GetSelectedObject6(1, -1)
vFeatArr = swFeatMgr.InsertReferencePoint(swRefPointAlongCurve, swRefPointAlongCurveEvenlyDistributed, 0#, 300)
Set swMgr = swModel.SketchManager
swModel.ClearSelection2 True
swModel.Insert3DSketch2 False
swMgr.AddToDB = True
For Each vFeat In vFeatArr
Set swFeat = vFeat
Set swRefPt = swFeat.GetSpecificFeature2
Set swRefPtData = swFeat.GetDefinition
Set swMathPt = swRefPt.GetRefPoint
Set swSkPt = swMgr.CreatePoint(swMathPt.ArrayData(0), swMathPt.ArrayData(1), swMathPt.ArrayData(2))
Next
swMgr.AddToDB = False
swModel.ClearSelection2 True
swModel.Insert3DSketch2 True
End Sub
-
