求一个完整的长方体solidworks二次开发程序,修改过的,可以改变长方体长宽高的程序 20

 我来答
乌龟鳄鱼ing
2014-04-07
知道答主
回答量:6
采纳率:0%
帮助的人:3.1万
展开全部

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

输入值即可生成立方体了!!

追问
长宽高可不可以直接输入数值,而不是坐标这么精细的,跪求~
已赞过 已踩过<
你对这个回答的评价是?
评论 收起
推荐律师服务: 若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询

为你推荐:

下载百度知道APP,抢鲜体验
使用百度知道APP,立即抢鲜体验。你的手机镜头里或许有别人想知道的答案。
扫描二维码下载
×

类别

我们会通过消息、邮箱等方式尽快将举报结果通知您。

说明

0/200

提交
取消

辅 助

模 式