Solidworks二次开发—07—控制草图对象

作者： unknow

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

@#---------------------------------------------

返回顶部

下一篇：数据库事务处理的另外一种方法 >>