AnsweredAssumed Answered

Extract "Sketch" Entity Information

Question asked by Darren Smith on Aug 18, 2019
Latest reply on Aug 19, 2019 by Rob Edwards

Can anybody help?

 

I have the following macro that lists the sketch "entity types" in a sketch...

 

Sub Main()
    Dim swModel As SldWorks.ModelDoc2

    Dim swSketch As SldWorks.Sketch

    Dim swSketchMgr As SldWorks.SketchManager

    Dim vSketchTextSegments As Variant

    Dim vSketchTextSegment As Variant

    Dim swSketchText As SldWorks.SketchText

    Dim swSketchLine As SldWorks.SketchLine

    Dim vSketchSegments As Variant

    Dim vSketchSegment As Variant

    Dim swSketchSegment As SldWorks.SketchSegment

    Dim bValue As Boolean

    Set swApp = Application.SldWorks

    Set swModel = swApp.ActiveDoc

    Set swSketchMgr = swModel.SketchManager

    swModel.ClearSelection2 True

    bValue = swModel.Extension.SelectByID2("Sketch1", "SKETCH", 0, 0, 0, False, 0, Nothing, 0)

    swSketchMgr.InsertSketch False

    Set swSketch = swModel.GetActiveSketch2

    vSketchTextSegments = swSketch.GetSketchTextSegments

    If (Not IsEmpty(vSketchTextSegments)) Then
        For Each vSketchTextSegment In vSketchTextSegments
            Set swSketchText = vSketchTextSegment
            MsgBox "Text = " & swSketchText.Text
        Next vSketchTextSegment
    End If

    vSketchSegments = swSketch.GetSketchSegments

    If (Not IsEmpty(vSketchSegments)) Then
        For Each vSketchSegment In vSketchSegments
            Set swSketchSegment = vSketchSegment

            Select Case swSketchSegment.GetType
                Case swSketchSegments_e.swSketchText
                    Set swSketchText = swSketchSegment

                    MsgBox "Sketch text = " & swSketchText.Text
                Case swSketchSegments_e.swSketchLine
                     Set swSketchLine = swSketchSegment

                     StartPointX = swSketchLine.IGetStartPoint * 1000

                     EndPointX = swSketchLine.IGetEndPoint * 1000

                     MsgBox StartPointX, 64, EndPointX
                Case swSketchSegments_e.swSketchARC
                    ' Set swSketchARC = swSketchSegment
            End Select
        Next vSketchSegment
    End If

    swSketchMgr.InsertSketch True
End Sub

 

I need to be able to extract the following information.

 

Line

X/Y Start Point

X/Y End Point

 

Arc

X/Y Centre Point

Radius

X/Y Start Point

X/Y End Point

 

Can anybody update the macro, shown above so that I can extract the information that I need?

 

Many thanks in advance!!!

 

Darren

Outcomes