Solidworks二次开发—07—控制草图对象Get All Elements of Sketch Example (VB)
Solidwork中对草图的控制，下面的例子很详细。特征下的草图在solidwork中其实是特征的子特征，我们可以对特征进行GetFirstSubFeature、及GetNextSubFeature得到。
如果有需要大家可以从中找到对直线、弧线、圆等对象的操作。代码是solidworks的示例文件，里面充斥了debug.print，只是向用户显示程序执行的结果。
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
'---------------------------------------------
