代码如下:
Private Sub Command1_Click()
Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Dim a1 As Double
Dim b1 As Double
Dim a2 As Double
Dim b2 As Double
a1 = CDbl(Text1.Text) / 1000 '定义第一节轴的长度
b1 = CDbl(Text2.Text) / 1000 '定义第一节轴肩的尺寸
a2 = CDbl(Text3.Text) / 1000 '定义第二节轴的长度
b2 = CDbl(Text4.Text) / 1000 '定义第二节轴的半径
Set swApp = CreateObject("SldWorks.Application")
Set Part = swApp.NewPart()
swApp.Visible = True
Part.InsertSketch2 True
Dim skSegment As Object
Set skSegment = Part.SketchManager.CreateLine(0, 0, 0, a1 + a2, 0, 0)
Set skSegment = Part.SketchManager.CreateLine(0, 0, 0, 0, b1 + b2, 0)
Set skSegment = Part.SketchManager.CreateLine(0, b1 + b2, 0, a1, b1 + b2, 0)
Set skSegment = Part.SketchManager.CreateLine(a1, b1 + b2, 0, a1, b1, 0)
Set skSegment = Part.SketchManager.CreateLine(a1, b1, 0, a1 + a2, b1, 0)
Set skSegment = Part.SketchManager.CreateLine(a1 + a2, b1, 0, a1 + a2, 0, 0)
boolstatus = Part.Extension.SelectByID2("草图1", "SKETCH", 0, 0, 0, False, 0, Nothing, 0)
boolstatus = Part.Extension.SelectByID2("Line1", "SKETCHSEGMENT", 2.10991438649471E-02, -3.06187683727577E-02, 1.55756714219314E-02, True, 16, Nothing, 0)
Dim myFeature As Object
Set myFeature = Part.FeatureManager.FeatureRevolve2(True, True, False, False, False, False, 0, 0, 6.2831853071796, 0, False, False, 0.01, 0.01, 0, 0, 0, True, True, True)
Part.SelectionManager.EnableContourSelection = False
End Sub
调试时在Set myFeature = Part.FeatureManager.FeatureRevolve2(True, True, False, False, False, False, 0, 0, 6.2831853071796, 0, False, False, 0.01, 0.01, 0, 0, 0, True, True, True)出现高亮,不能通过。
并且只能在调出的SW界面中只能出现所需要的草图,没有进行旋转的命令 |