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 '---------------------------------------------
|
