Hide Table of Contents

Get All Elements of Sketch Example (VBA)

This example shows how to get all of the elements of a sketch.

 

'---------------------------------------------

'

' Preconditions: Model document is open and a sketch is selected.

'

' Postconditions: None

'

'---------------------------------------------

 

Option Explicit

Public Enum swSkSegments_e

    swSketchLINE = 0

    swSketchARC = 1

    swSketchELLIPSE = 2

    swSketchSPLINE = 3

    swSketchTEXT = 4

    swSketchPARABOLA = 5

End Enum

Sub ProcessTextFormat _

( _

    swApp As SldWorks.SldWorks, _

    swModel As SldWorks.ModelDoc2, _

    swTextFormat As SldWorks.textFormat _

)

    Debug.Print "        BackWards                    = " & swTextFormat.BackWards

    Debug.Print "        Bold                         = " & swTextFormat.Bold

    Debug.Print "        CharHeight                   = " & swTextFormat.CharHeight

    Debug.Print "        CharHeightInPts              = " & swTextFormat.CharHeightInPts

    Debug.Print "        CharSpacingFactor            = " & swTextFormat.CharSpacingFactor

    Debug.Print "        Escapement                   = " & swTextFormat.Escapement

    Debug.Print "        IsHeightSpecifiedInPts       = " & swTextFormat.IsHeightSpecifiedInPts

    Debug.Print "        Italic                       = " & swTextFormat.Italic

    Debug.Print "        LineLength                   = " & swTextFormat.LineLength

    Debug.Print "        LineSpacing                  = " & swTextFormat.LineSpacing

    Debug.Print "        ObliqueAngle                 = " & swTextFormat.ObliqueAngle

    Debug.Print "        Strikeout                    = " & swTextFormat.Strikeout

    Debug.Print "        TypeFaceName                 = " & swTextFormat.TypeFaceName

    Debug.Print "        Underline                    = " & swTextFormat.Underline

    Debug.Print "        UpsideDown                   = " & swTextFormat.UpsideDown

    Debug.Print "        Vertical                     = " & swTextFormat.Vertical

    Debug.Print "        WidthFactor                  = " & swTextFormat.WidthFactor

    Debug.Print ""

End Sub

Function TransformSketchPointToModelSpace _

( _

    swApp As SldWorks.SldWorks, _

    swModel As SldWorks.ModelDoc2, _

    swSketch As SldWorks.sketch, _

    swSkPt As SldWorks.SketchPoint _

) As SldWorks.MathPoint

    Dim swMathUtil              As SldWorks.MathUtility

    Dim swXform                 As SldWorks.MathTransform

    Dim nPt(2)                  As Double

    Dim vPt                     As Variant

    Dim swMathPt                As SldWorks.MathPoint

    

    nPt(0) = swSkPt.x:      nPt(1) = swSkPt.y:      nPt(2) = swSkPt.z

    vPt = nPt

    

    Set swMathUtil = swApp.GetMathUtility

    Set swXform = swSketch.ModelToSketchTransform

    Set swXform = swXform.Inverse

    Set swMathPt = swMathUtil.CreatePoint((vPt))

    Set swMathPt = swMathPt.MultiplyTransform(swXform)

    Set TransformSketchPointToModelSpace = swMathPt

End Function

Sub ProcessSketchLine _

( _

    swApp As SldWorks.SldWorks, _

    swModel As SldWorks.ModelDoc2, _

    swSketch As SldWorks.sketch, _

    swSkLine As SldWorks.SketchLine _

)

    Dim swStartPt               As SldWorks.SketchPoint

    Dim swEndPt                 As SldWorks.SketchPoint

    Dim swStartModPt            As SldWorks.MathPoint

    Dim swEndModPt              As SldWorks.MathPoint

    Set swStartPt = swSkLine.GetStartPoint2

    Set swEndPt = swSkLine.GetEndPoint2

    Set swStartModPt = TransformSketchPointToModelSpace(swApp, swModel, swSketch, swStartPt)

    Set swEndModPt = TransformSketchPointToModelSpace(swApp, swModel, swSketch, swEndPt)

    Debug.Print "      Start (sketch)   = (" & swStartPt.x * 1000# & ", " & swStartPt.y * 1000# & ", " & swStartPt.z * 1000# & ") mm"

    Debug.Print "      Start (model )   = (" & swStartModPt.ArrayData(0) * 1000# & ", " & swStartModPt.ArrayData(1) * 1000# & ", " & swStartModPt.ArrayData(2) * 1000# & ") mm"

    Debug.Print "      End   (sketch)   = (" & swEndPt.x * 1000# & ", " & swEndPt.y * 1000# & ", " & swEndPt.z * 1000# & ") mm"

    Debug.Print "      End   (model )   = (" & swEndModPt.ArrayData(0) * 1000# & ", " & swEndModPt.ArrayData(1) * 1000# & ", " & swEndModPt.ArrayData(2) * 1000# & ") mm"

End Sub

Sub ProcessSketchArc _

( _

    swApp As SldWorks.SldWorks, _

    swModel As SldWorks.ModelDoc2, _

    swSketch As SldWorks.sketch, _

    swSkArc As SldWorks.SketchArc _

)

    Dim swStartPt               As SldWorks.SketchPoint

    Dim swEndPt                 As SldWorks.SketchPoint

    Dim swCtrPt                 As SldWorks.SketchPoint

    Dim vNormal                 As Variant

    Dim swStartModPt            As SldWorks.MathPoint

    Dim swEndModPt              As SldWorks.MathPoint

    Dim swCtrModPt              As SldWorks.MathPoint

    

    Set swStartPt = swSkArc.GetStartPoint2

    Set swEndPt = swSkArc.GetEndPoint2

    Set swCtrPt = swSkArc.GetCenterPoint2

    Set swStartModPt = TransformSketchPointToModelSpace(swApp, swModel, swSketch, swStartPt)

    Set swEndModPt = TransformSketchPointToModelSpace(swApp, swModel, swSketch, swEndPt)

    Set swCtrModPt = TransformSketchPointToModelSpace(swApp, swModel, swSketch, swCtrPt)

    

    vNormal = swSkArc.GetNormalVector

    

    Debug.Print "      Start (sketch)   = (" & swStartPt.x * 1000# & ", " & swStartPt.y * 1000# & ", " & swStartPt.z * 1000# & ") mm"

    Debug.Print "      Start (model )   = (" & swStartModPt.ArrayData(0) * 1000# & ", " & swStartModPt.ArrayData(1) * 1000# & ", " & swStartModPt.ArrayData(2) * 1000# & ") mm"

    Debug.Print "      End   (sketch)   = (" & swEndPt.x * 1000# & ", " & swEndPt.y * 1000# & ", " & swEndPt.z * 1000# & ") mm"

    Debug.Print "      End   (model )   = (" & swEndModPt.ArrayData(0) * 1000# & ", " & swEndModPt.ArrayData(1) * 1000# & ", " & swEndModPt.ArrayData(2) * 1000# & ") mm"

    Debug.Print "      Center(sketch)   = (" & swCtrPt.x * 1000# & ", " & swCtrPt.y * 1000# & ", " & swCtrPt.z * 1000# & ") mm"

    Debug.Print "      Center(model )   = (" & swCtrModPt.ArrayData(0) * 1000# & ", " & swCtrModPt.ArrayData(1) * 1000# & ", " & swCtrModPt.ArrayData(2) * 1000# & ") mm"

    Debug.Print "      Radius           = " & swSkArc.GetRadius * 1000# & " mm"

    Debug.Print "      IsCircle         = " & CBool(swSkArc.IsCircle)

    Debug.Print "      Rot dirn         = " & swSkArc.GetRotationDir

End Sub

Sub ProcessSketchEllipse _

( _

    swApp As SldWorks.SldWorks, _

    swModel As SldWorks.ModelDoc2, _

    swSketch As SldWorks.sketch, _

    swSkEllipse As SldWorks.SketchEllipse _

)

    Dim swStartPt               As SldWorks.SketchPoint

    Dim swEndPt                 As SldWorks.SketchPoint

    Dim swCtrPt                 As SldWorks.SketchPoint

    Dim swMajPt                 As SldWorks.SketchPoint

    Dim swMinPt                 As SldWorks.SketchPoint

    Dim swStartModPt            As SldWorks.MathPoint

    Dim swEndModPt              As SldWorks.MathPoint

    Dim swCtrModPt              As SldWorks.MathPoint

    Dim swMajModPt              As SldWorks.MathPoint

    Dim swMinModPt              As SldWorks.MathPoint

    Set swStartPt = swSkEllipse.GetStartPoint2

    Set swEndPt = swSkEllipse.GetEndPoint2

    Set swCtrPt = swSkEllipse.GetCenterPoint2

    Set swMajPt = swSkEllipse.GetMajorPoint2

    Set swMinPt = swSkEllipse.GetMinorPoint2

    Set swStartModPt = TransformSketchPointToModelSpace(swApp, swModel, swSketch, swStartPt)

    Set swEndModPt = TransformSketchPointToModelSpace(swApp, swModel, swSketch, swEndPt)

    Set swCtrModPt = TransformSketchPointToModelSpace(swApp, swModel, swSketch, swCtrPt)

    Set swMajModPt = TransformSketchPointToModelSpace(swApp, swModel, swSketch, swMajPt)

    Set swMinModPt = TransformSketchPointToModelSpace(swApp, swModel, swSketch, swMinPt)

    Debug.Print "      Start (sketch)   = (" & swStartPt.x * 1000# & ", " & swStartPt.y * 1000# & ", " & swStartPt.z * 1000# & ") mm"

    Debug.Print "      Start (model )   = (" & swStartModPt.ArrayData(0) * 1000# & ", " & swStartModPt.ArrayData(1) * 1000# & ", " & swStartModPt.ArrayData(2) * 1000# & ") mm"

    Debug.Print "      End   (sketch)   = (" & swEndPt.x * 1000# & ", " & swEndPt.y * 1000# & ", " & swEndPt.z * 1000# & ") mm"

    Debug.Print "      End   (model )   = (" & swEndModPt.ArrayData(0) * 1000# & ", " & swEndModPt.ArrayData(1) * 1000# & ", " & swEndModPt.ArrayData(2) * 1000# & ") mm"

    Debug.Print "      Center(sketch)   = (" & swCtrPt.x * 1000# & ", " & swCtrPt.y * 1000# & ", " & swCtrPt.z * 1000# & ") mm"

    Debug.Print "      Center(model )   = (" & swCtrModPt.ArrayData(0) * 1000# & ", " & swCtrModPt.ArrayData(1) * 1000# & ", " & swCtrModPt.ArrayData(2) * 1000# & ") mm"

    Debug.Print "      Major (sketch)   = (" & swMajPt.x * 1000# & ", " & swMajPt.y * 1000# & ", " & swMajPt.z * 1000# & ") mm"

    Debug.Print "      Major (model )   = (" & swMajModPt.ArrayData(0) * 1000# & ", " & swMajModPt.ArrayData(1) * 1000# & ", " & swMajModPt.ArrayData(2) * 1000# & ") mm"

    Debug.Print "      Minor (sketch)   = (" & swMinPt.x * 1000# & ", " & swMinPt.y * 1000# & ", " & swMinPt.z * 1000# & ") mm"

    Debug.Print "      Minor (model )   = (" & swMinModPt.ArrayData(0) * 1000# & ", " & swMinModPt.ArrayData(1) * 1000# & ", " & swMinModPt.ArrayData(2) * 1000# & ") mm"

End Sub

Sub ProcessSketchSpline _

( _

    swApp As SldWorks.SldWorks, _

    swModel As SldWorks.ModelDoc2, _

    swSketch As SldWorks.sketch, _

    swSkSpline As SldWorks.SketchSpline _

)

    Dim vSplinePtArr            As Variant

    Dim vSplinePt               As Variant

    Dim swSplinePt              As SldWorks.SketchPoint

    Dim swSplineModPt           As SldWorks.MathPoint

    

    vSplinePtArr = swSkSpline.GetPoints2

    For Each vSplinePt In vSplinePtArr

        Set swSplinePt = vSplinePt

        Set swSplineModPt = TransformSketchPointToModelSpace(swApp, swModel, swSketch, swSplinePt)

    

        Debug.Print "      Spline (sketch)  = (" & swSplinePt.x * 1000# & ", " & swSplinePt.y * 1000# & ", " & swSplinePt.z * 1000# & ") mm"

        Debug.Print "      Spline (model )  = (" & swSplineModPt.ArrayData(0) * 1000# & ", " & swSplineModPt.ArrayData(1) * 1000# & ", " & swSplineModPt.ArrayData(2) * 1000# & ") mm"

    Next vSplinePt

End Sub

Sub ProcessSketchText _

( _

    swApp As SldWorks.SldWorks, _

    swModel As SldWorks.ModelDoc2, _

    swSketch As SldWorks.sketch, _

    swSkText As SldWorks.SketchText _

)

    Dim vCoordPt                As Variant

    Dim swMathUtil              As SldWorks.MathUtility

    Dim swXform                 As SldWorks.MathTransform

    Dim swCoordModPt            As SldWorks.MathPoint

    

    vCoordPt = swSkText.GetCoordinates

    

    Set swMathUtil = swApp.GetMathUtility

    Set swXform = swSketch.ModelToSketchTransform

    Set swXform = swXform.Inverse

    Set swCoordModPt = swMathUtil.CreatePoint((vCoordPt))

    Set swCoordModPt = swCoordModPt.MultiplyTransform(swXform)

    Debug.Print "      Coords (sketch)  = (" & vCoordPt(0) * 1000# & ", " & vCoordPt(1) * 1000# & ", " & vCoordPt(2) * 1000# & ") mm"

    Debug.Print "      Coords (model )  = (" & swCoordModPt.ArrayData(0) * 1000# & ", " & swCoordModPt.ArrayData(1) * 1000# & ", " & swCoordModPt.ArrayData(2) * 1000# & ") mm"

    Debug.Print "      Use doc fmt      = " & swSkText.GetUseDocTextFormat

    Debug.Print "      Text             = " & swSkText.text

    

    ProcessTextFormat swApp, swModel, swSkText.GetTextFormat

End Sub

Sub ProcessSketchParabola _

( _

    swApp As SldWorks.SldWorks, _

    swModel As SldWorks.ModelDoc2, _

    swSketch As SldWorks.sketch, _

    swSkParabola As SldWorks.SketchParabola _

)

    Dim swApexPt                As SldWorks.SketchPoint

    Dim swStartPt               As SldWorks.SketchPoint

    Dim swEndPt                 As SldWorks.SketchPoint

    Dim swFocalPt               As SldWorks.SketchPoint

    Dim swApexModPt             As SldWorks.MathPoint

    Dim swStartModPt            As SldWorks.MathPoint

    Dim swEndModPt              As SldWorks.MathPoint

    Dim swFocalModPt            As SldWorks.MathPoint

    Set swApexPt = swSkParabola.GetApexPoint2

    Set swStartPt = swSkParabola.GetStartPoint2

    Set swEndPt = swSkParabola.GetEndPoint2

    Set swFocalPt = swSkParabola.GetFocalPoint2

    Set swApexModPt = TransformSketchPointToModelSpace(swApp, swModel, swSketch, swApexPt)

    Set swStartModPt = TransformSketchPointToModelSpace(swApp, swModel, swSketch, swStartPt)

    Set swEndModPt = TransformSketchPointToModelSpace(swApp, swModel, swSketch, swEndPt)

    Set swFocalModPt = TransformSketchPointToModelSpace(swApp, swModel, swSketch, swFocalPt)

    Debug.Print "      Apex  (sketch)   = (" & swApexPt.x * 1000# & ", " & swApexPt.y * 1000# & ", " & swApexPt.z * 1000# & ") mm"

    Debug.Print "      Apex  (model )   = (" & swApexModPt.ArrayData(0) * 1000# & ", " & swApexModPt.ArrayData(1) * 1000# & ", " & swApexModPt.ArrayData(2) * 1000# & ") mm"

    Debug.Print "      Start (sketch)   = (" & swStartPt.x * 1000# & ", " & swStartPt.y * 1000# & ", " & swStartPt.z * 1000# & ") mm"

    Debug.Print "      Start (model )   = (" & swStartModPt.ArrayData(0) * 1000# & ", " & swStartModPt.ArrayData(1) * 1000# & ", " & swStartModPt.ArrayData(2) * 1000# & ") mm"

    Debug.Print "      End   (sketch)   = (" & swEndPt.x * 1000# & ", " & swEndPt.y * 1000# & ", " & swEndPt.z * 1000# & ") mm"

    Debug.Print "      End   (model )   = (" & swEndModPt.ArrayData(0) * 1000# & ", " & swEndModPt.ArrayData(1) * 1000# & ", " & swEndModPt.ArrayData(2) * 1000# & ") mm"

    Debug.Print "      Focal (sketch)   = (" & swFocalPt.x * 1000# & ", " & swFocalPt.y * 1000# & ", " & swFocalPt.z * 1000# & ") mm"

    Debug.Print "      Focal (model )   = (" & swFocalModPt.ArrayData(0) * 1000# & ", " & swFocalModPt.ArrayData(1) * 1000# & ", " & swFocalModPt.ArrayData(2) * 1000# & ") mm"

End Sub

Sub main()

    Dim sSkSegmentsName(5)      As String

    Dim swApp                   As SldWorks.SldWorks

    Dim swModel                 As SldWorks.ModelDoc2

    Dim swSelMgr                As SldWorks.SelectionMgr

    Dim swFeat                  As SldWorks.feature

    Dim swSketch                As SldWorks.sketch

    Dim vSkSegArr               As Variant

    Dim vSkSeg                  As Variant

    Dim swSkSeg                 As SldWorks.SketchSegment

    Dim swSkLine                As SldWorks.SketchLine

    Dim swSkArc                 As SldWorks.SketchArc

    Dim swSkEllipse             As SldWorks.SketchEllipse

    Dim swSkSpline              As SldWorks.SketchSpline

    Dim swSkText                As SldWorks.SketchText

    Dim swSkParabola            As SldWorks.SketchParabola

    Dim vID                     As Variant

    Dim i                       As Long

    Dim bRet                    As Boolean

    

    sSkSegmentsName(swSketchLINE) = "swSketchLINE"

    sSkSegmentsName(swSketchARC) = "swSketchARC"

    sSkSegmentsName(swSketchELLIPSE) = "swSketchELLIPSE"

    sSkSegmentsName(swSketchSPLINE) = "swSketchSPLINE"

    sSkSegmentsName(swSketchTEXT) = "swSketchTEXT"

    sSkSegmentsName(swSketchPARABOLA) = "swSketchPARABOLA"

    

    

    Set swApp = Application.SldWorks

    Set swModel = swApp.ActiveDoc

    Set swSelMgr = swModel.SelectionManager

    Set swFeat = swSelMgr.GetSelectedObject5(1)

    Set swSketch = swFeat.GetSpecificFeature

    

    Debug.Print "Feature = " & swFeat.Name & " [" & swSketch.Is3D & "]"

    Debug.Print "  Sketch Segments:"

    

    vSkSegArr = swSketch.GetSketchSegments

    For Each vSkSeg In vSkSegArr

        Set swSkSeg = vSkSeg

        

        vID = swSkSeg.GetId

        Debug.Print "    ID = [" & vID(0) & "," & vID(1) & "]"

        Debug.Print "      Type             = " & sSkSegmentsName(swSkSeg.GetType)

        Debug.Print "      ConstGeom        = " & swSkSeg.ConstructionGeometry

    

        Select Case swSkSeg.GetType

            Case swSketchLINE

                Set swSkLine = swSkSeg

                

                ProcessSketchLine swApp, swModel, swSketch, swSkLine

            

            Case swSketchARC

                Set swSkArc = swSkSeg

            

                ProcessSketchArc swApp, swModel, swSketch, swSkArc

            

            Case swSketchELLIPSE

                Set swSkEllipse = swSkSeg

                

                ProcessSketchEllipse swApp, swModel, swSketch, swSkEllipse

            

            Case swSketchSPLINE

                Set swSkSpline = swSkSeg

                

                ProcessSketchSpline swApp, swModel, swSketch, swSkSpline

            

            Case swSketchTEXT

                Set swSkText = swSkSeg

                

                ProcessSketchText swApp, swModel, swSketch, swSkText

            

            Case swSketchPARABOLA

                Set swSkParabola = swSkSeg

                

                ProcessSketchParabola swApp, swModel, swSketch, swSkParabola

                

            Case Default

                Debug.Assert False

        End Select

    Next vSkSeg

End Sub

'---------------------------------------------



Provide feedback on this topic

SOLIDWORKS welcomes your feedback concerning the presentation, accuracy, and thoroughness of the documentation. Use the form below to send your comments and suggestions about this topic directly to our documentation team. The documentation team cannot answer technical support questions. Click here for information about technical support.

* Required

 
*Email:  
Subject:   Feedback on Help Topics
Page:   Get All Elements of Sketch Example (VBA)
*Comment:  
*   I acknowledge I have read and I hereby accept the privacy policy under which my Personal Data will be used by Dassault Systèmes

Print Topic

Select the scope of content to print:



x

We have detected you are using a browser version older than Internet Explorer 7. For optimized display, we suggest upgrading your browser to Internet Explorer 7 or newer.

 Never show this message again
x

Web Help Content Version: API Help (English only) 2016 SP05

To disable Web help from within SOLIDWORKS and use local help instead, click Help > Use SOLIDWORKS Web Help.

To report problems encountered with the Web help interface and search, contact your local support representative. To provide feedback on individual help topics, use the “Feedback on this topic” link on the individual topic page.