Hello,
Is it possible to split a 3d line with planes
I am not able to find a Split method on Sketchline3d
{Code}
Sub Split_Lines()
If ThisApplication.Documents.Count = 0 Then Exit Sub
If ThisApplication.ActiveDocument.DocumentType <> kPartDocumentObject Then Exit Sub
' Check to make sure a sketch is active.
If Not TypeOf ThisApplication.ActiveEditObject Is Sketch3D Then
MsgBox "A sketch must be active."
Exit Sub
End If
Dim oPartCompdef As PartComponentDefinition
Set oPartCompdef = ThisApplication.ActiveDocument.ComponentDefinition
' Set a reference to the active sketch.
Dim oSketch As Sketch3D
Set oSketch = ThisApplication.ActiveEditObject
' Set a reference to the transient geometry collection.
Dim oTransGeom As TransientGeometry
Set oTransGeom = ThisApplication.TransientGeometry
Dim SketchLine As SketchLine3D
Dim WorkPl As WorkPlane
Dim i As Integer
For Each SketchLine In oSketch.SketchLines3D
For Each WorkPl In oPartCompdef.WorkPlanes
'What should be done here ??
Next
Next
End Sub
{Code}
Solved! Go to Solution.
Solved by Vladimir.Ananyev. Go to Solution.
Unlike SketchSpline3D object Sketchline3d has no Split method. But this function can be easily created.
Here is simple workaround. Create sketch line 3D intersected Y-Z base work plane and run the following VBA sample code.
Sub Split_Line_By_Workplane() ' Set a reference to the transient geometry collection. Dim oTG As TransientGeometry Set oTG = ThisApplication.TransientGeometry Dim oDoc As PartDocument Set oDoc = ThisApplication.ActiveDocument Dim oDef As PartComponentDefinition Set oDef = oDoc.ComponentDefinition ' Set a reference to the active sketch Dim oSketch3D As Sketch3D Set oSketch3D = oDef.Sketches3D.Item(1) 'some workplane Dim oWP As WorkPlane Set oWP = oDef.WorkPlanes.Item(1) 'some SketchLine3D object Dim oSketchLine3D As SketchLine3D Set oSketchLine3D = oSketch3D.SketchLines3D.Item(1) '--- find intersection point --- Dim oLineSegment As LineSegment Set oLineSegment = oSketchLine3D.Geometry Dim oObjectsEnumerator As ObjectsEnumerator Set oObjectsEnumerator = oLineSegment.IntersectWithSurface(oWP.Plane) If oObjectsEnumerator Is Nothing Then MsgBox "No intersection" Exit Sub End If 'sketch 3D-points collection Dim oSkPoints3d As SketchPoints3D Set oSkPoints3d = oSketch3D.SketchPoints3D 'SketchPoint3D at the intersection point Dim oPoint As Point Set oPoint = oObjectsEnumerator.Item(1) Dim oP0 As SketchPoint3D Set oP0 = oSkPoints3d.Add(oPoint) oP0.HoleCenter = False 'start point Dim oP1 As SketchPoint3D Set oP1 = oSketchLine3D.StartSketchPoint 'end point Dim oP2 As SketchPoint3D Set oP2 = oSketchLine3D.EndSketchPoint 'save end point in the new point Dim oP3 As SketchPoint3D Set oP3 = oSkPoints3d.Add(oSketchLine3D.EndSketchPoint.Geometry) oP3.HoleCenter = False 'shorten source line moving 'old end point to the intersection point Call oP2.ConnectTo(oP0) 'create the second line Dim oSketchLine3d2 As SketchLine3D Set oSketchLine3d2 = oSketch3D.SketchLines3D.AddByTwoPoints(oP0, oP3) 'add collinear constraint if needed Dim oGeomConstraints As GeometricConstraints3D Set oGeomConstraints = oSketch3D.GeometricConstraints3D Call oGeomConstraints.AddCollinear(oSketchLine3D, oSketchLine3d2) End Sub
Hope the idea is clear.
Thanks Vladimir,
It is exactly what I wanted. I understood the concept
Thanks again