对象|控制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



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