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

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

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

  • 0
    点赞
  • 4
    收藏
    觉得还不错? 一键收藏
  • 1
    评论

“相关推荐”对你有帮助么?

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
评论 1
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值