求一个完整的长方体solidworks二次开发程序,修改过的,可以改变长方体长宽高的程序 20
Private Sub Command1_Click()
Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Dim a As Integer
Dim b As Integer
Dim c As Integer
Dim d As Integer
Dim e As Integer
Set swApp = CreateObject("SldWorks.application")
Set Part = swApp.NewPart()
boolstatus = Part.Extension.SelectByID2("前视基准面", "PLANE", 0, 0, 0, False, 0, Nothing, 0)
Part.SketchManager.InsertSketch True
Dim vSkLines As Variant
a = Txt1.Text
b = Txt2.Text
c = Txt3.Text
d = Txt4.Text
vSkLines = Part.SketchManager.CreateCornerRectangle(a * 0.001, b * 0.001, 0, c * 0.001, d * 0.001, 0)
Part.ShowNamedView2 "*上下二等角轴测", 8
boolstatus = Part.Extension.SelectByID2("Line2", "SKETCHSEGMENT", 0, 0, 0, False, 0, Nothing, 0)
boolstatus = Part.Extension.SelectByID2("Line1", "SKETCHSEGMENT", 0, 0, 0, True, 0, Nothing, 0)
boolstatus = Part.Extension.SelectByID2("Line4", "SKETCHSEGMENT", 0, 0, 0, True, 0, Nothing, 0)
boolstatus = Part.Extension.SelectByID2("Line3", "SKETCHSEGMENT", 0, 0, 0, True, 0, Nothing, 0)
Dim myFeature As Object
e = Txt5.Text
Set myFeature = Part.FeatureManager.FeatureExtrusion2(True, False, False, 0, 0, e * 0.001, 0, False, False, False, False, 0.01745329251994, 0.01745329251994, False, False, False, False, True, True, True, 0, 0, False)
Part.SelectionManager.EnableContourSelection = False
End Sub
输入值即可生成立方体了!!
长宽高可不可以直接输入数值,而不是坐标这么精细的,跪求~