AnsweredAssumed Answered

Getting a sketch segment's underlying curve and using CreateTrimmedSheet4

Question asked by Cody Kirsch on Jun 22, 2017
Latest reply on Nov 8, 2018 by Cody Kirsch
  • Comment • 4

I am working on a macro feature that uses a sketch to to create a kind of custom extrude cut with some extra features but am having trouble with being able get the underlying curves of the sketch. I can do everything I need to use a temporary body to cut the work body except make the body from a sketch

 

My approach for making the temporary body from a sketch is this:

Get All ISketchSegment of selected sketch

Get ICurve of each ISketchSegment and put into and array

     Use a Transfrorm to move the ICurve from sketch coordinates Into model space coordinates

Get ISurface of the IFace2 the selected ISketch is on (or make a copy of it using ISurface::Copy?)

Use ISurface::CreateTrimmedSheet4 to create a sheet body

 

The problem I am having is that all the curves from sketches are are 2000 meters long for some reason. They are all in the right place though. I am testing it on a simple 86 in. by 36 in. rectangle.I have never used CreateTrimmedSheet4 before but I'm guessing there needs to be closed curves for it to work. I also have no idea how this would behave if there were multiple closed chains in the sketch. The sketch and SurFace are gotten from the regeneration function of the macro feature.

 

Function CreateCutBody(sketch As SldWorks.sketch, SurFace As SldWorks.Face2) As SldWorks.Body2()

Dim swSurf As SldWorks.SurFace

Dim SktXForm As SldWorks.MathTransform

Dim swSktSeg As SldWorks.SketchSegment

Dim swCurve() As SldWorks.Curve

Dim WrieBody() As SldWorks.Body2

Dim vRetBods As Variant

Dim vSeg As Variant

Dim vCur As Variant

Dim i As Integer

On Error GoTo errH

 

    Set swSurf = SurFace.GetSurface

    Set SktXForm = swSketch.ModelToSketchTransform

    vSeg = sketch.GetSketchSegments

    ReDim swCurve(UBound(vSeg))

    ReDim WrieBody(UBound(vSeg))

       

    For i = 0 To (UBound(vSeg))

        Set swSktSeg = vSeg(i)

        Set swCurve(i) = swSktSeg.GetCurve

        swCurve(i).ApplyTransform SktXForm

        Set WrieBody(i) = swCurve(i).CreateWireBody

        WrieBody(i).Display3 swPart, 255, 1

    Next i

   

    Set vRetBods = swSurf.CreateTrimmedSheet4(swCurve, False)

    CreateCutBody = vRetBods

 

Exit Function

errH: Debug.Print "CreateCutBody Error: " & Err.Description

End Function

Cody Kirsch
Cody Kirsch Aug 17, 2017 1:48 PM
Correct Answer

100% Working!

CutSktFeat is the feature holding the sketch, SelFace is the selected face, and EditBody is the body the cut extrude is being applied to.

The trick to this one is lines 71 and 72. The Extrude depth is an arbitrary 6 meters.

 

Function CreateCutBody(CutSktFeat As Feature, SelFace As Face2, EditBody As Body2) As SldWorks.Body2
Dim SktXForm As SldWorks.MathTransform
Dim swCurveParams As SldWorks.CurveParamData
Dim dirVector As SldWorks.MathVector
Dim swMath As SldWorks.MathUtility


Dim swRetBods As SldWorks.Body2
Dim TempBody As SldWorks.Body2
Dim swTrimBody As SldWorks.Body2
Dim swWorkBody As SldWorks.Body2
Dim swToolBody As SldWorks.Body2


Dim TmpSurf As SldWorks.SurFace


Dim swSketch As SldWorks.Sketch
Dim swSktContour As SldWorks.SketchContour


Dim swSktCurve As SldWorks.Curve
Dim swCurve() As SldWorks.Curve


Dim swSktSeg As SldWorks.SketchSegment
Dim swEdge As SldWorks.Edge


Dim RootPoint(2) As Double
Dim Normal() As Double
Dim InvNorm(2) As Double


Dim vContours As Variant
Dim vRetBody As Variant
Dim vFacePt As Variant
Dim vStrPt As Variant
Dim vEndPt As Variant
Dim vEdges As Variant


Dim lngErr As Long
Dim i As Integer
Dim n As Integer


On Error GoTo errH


    Set swModeler = swApp.GetModeler
    Set swMath = swApp.GetMathUtility
    
    Set swWorkBody = EditBody
    Set swSketch = CutSktFeat.GetSpecificFeature2
    Set SktXForm = swSketch.ModelToSketchTransform
    
    Normal = SelFace.Normal
    InvNorm(0) = -Normal(0)
    InvNorm(1) = -Normal(1)
    InvNorm(2) = -Normal(2)
    
    vFacePt = SelFace.GetClosestPointOn(0, 0, 0)
    vContours = swSketch.GetSketchContours
    
    RootPoint(0) = vFacePt(0) 'X
    RootPoint(1) = vFacePt(1) 'Y
    RootPoint(2) = vFacePt(2) 'Z


    Set TempBody = swPart.CreateNewBody
    Set TmpSurf = TempBody.CreatePlanarSurface(RootPoint, Normal)
    
    For i = 0 To (UBound(vContours))
        Set swSktContour = vContours(i)
        
        vEdges = swSktContour.GetEdges
        
        ReDim DisBod(UBound(vEdges))
        ReDim swCurve(UBound(vEdges))
        
        For n = 0 To UBound(vEdges)
            Set swEdge = vEdges(n)
            
            Set swCurveParams = swEdge.GetCurveParams3
            Set swSktCurve = swEdge.GetCurve
            
            vStrPt = swCurveParams.StartPoint
            vEndPt = swCurveParams.EndPoint
            
            Set swSktCurve = swSktCurve.CreateTrimmedCurve2(vStrPt(0), vStrPt(1), vStrPt(2), vEndPt(0), vEndPt(1), vEndPt(2))
            Set swCurve(n) = swSktCurve
        Next n
        Set swTrimBody = TmpSurf.CreateTrimmedSheet((swCurve))
        
        Set dirVector = swMath.CreateVector((InvNorm))
        Set swToolBody = swModeler.CreateExtrudedBody(swTrimBody, dirVector, 6 * m)
        swToolBody.Display3 swModel, RGB(1, 0, 0), 0
        
        vRetBody = swWorkBody.Operations2(SWBODYCUT, swToolBody, lngErr)
        Set swWorkBody = vRetBody(0)
        
    Next i
    
    Set CreateCutBody = swWorkBody


Exit Function
errH: Debug.Print "CreateCutBody Error: " & Err.Description
End Function
See the reply in context
No one else had this question

Outcomes

    Visibility: API/Macros670 Views
    Last modified on Jun 22, 2017 9:25 AM