王朝网络
分享
 
 
 

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

王朝other·作者佚名  2006-01-09
宽屏版  字体: |||超大  

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

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

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
2023年上半年GDP全球前十五强
 百态   2023-10-24
美众议院议长启动对拜登的弹劾调查
 百态   2023-09-13
上海、济南、武汉等多地出现不明坠落物
 探索   2023-09-06
印度或要将国名改为“巴拉特”
 百态   2023-09-06
男子为女友送行,买票不登机被捕
 百态   2023-08-20
手机地震预警功能怎么开?
 干货   2023-08-06
女子4年卖2套房花700多万做美容:不但没变美脸,面部还出现变形
 百态   2023-08-04
住户一楼被水淹 还冲来8头猪
 百态   2023-07-31
女子体内爬出大量瓜子状活虫
 百态   2023-07-25
地球连续35年收到神秘规律性信号,网友:不要回答!
 探索   2023-07-21
全球镓价格本周大涨27%
 探索   2023-07-09
钱都流向了那些不缺钱的人,苦都留给了能吃苦的人
 探索   2023-07-02
倩女手游刀客魅者强控制(强混乱强眩晕强睡眠)和对应控制抗性的关系
 百态   2020-08-20
美国5月9日最新疫情:美国确诊人数突破131万
 百态   2020-05-09
荷兰政府宣布将集体辞职
 干货   2020-04-30
倩女幽魂手游师徒任务情义春秋猜成语答案逍遥观:鹏程万里
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案神机营:射石饮羽
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案昆仑山:拔刀相助
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案天工阁:鬼斧神工
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案丝路古道:单枪匹马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:与虎谋皮
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:李代桃僵
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案镇郊荒野:指鹿为马
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:小鸟依人
 干货   2019-11-12
倩女幽魂手游师徒任务情义春秋猜成语答案金陵:千金买邻
 干货   2019-11-12
 
>>返回首页<<
推荐阅读
 
 
频道精选
 
静静地坐在废墟上,四周的荒凉一望无际,忽然觉得,凄凉也很美
© 2005- 王朝网络 版权所有