> Get All Elements of Sketch Example (VBA)

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

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

Search 'Get All Elements of Sketch Example (VBA)' in the SOLIDWORKS Knowledge Base.

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

Cancel

Print Topic

Select the scope of content to print:

This topic and all topics linked from this topic

Just this topic

This topic and only immediate topics under it

This selected topic and all subtopics

Cancel

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

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.