|
超级版主
注册日期: 04-03
帖子: 18592
精华: 36
现金: 249466 标准币
资产: 1080358888 标准币
|
【转帖】solidworks二次开发之零件篇-VB（原创）
只需要用VB做一个按钮就可以实现
Option Explicit
Private Sub Command1_Click()
Dim swApp As SldWorks.SldWorks
Dim Part As Object
Set swApp = CreateObject("SldWorks.application")
swApp.Visible = True '让后台运行的SW显示出来
swApp.UserControl = True
End Sub
VB程序，前提是SW已经打开。。。结合前面的启动篇就不需要打开。。。VB窗口形式的图形在后面。。。
Option Explicit
Private Sub Command1_Click()
Dim swApp As SldWorks.SldWorks
Dim Part As Object
Dim SelMgr As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Dim Feature As Object
Set swApp = CreateObject("sldworks.application")
Set Part = swApp.NewDocument("D:\Program Files\SolidWorks\lang\chinese-simplified\Tutorial\part.prtdot", 0, 0#, 0#)
Set Part = swApp.ActivateDoc2("零件1", False, longstatus)
swApp.ActiveDoc.ActiveView.FrameWidth = 1205
swApp.ActiveDoc.ActiveView.FrameHeight = 820
swApp.ActiveDoc.ActiveView.FrameLeft = 0
swApp.ActiveDoc.ActiveView.FrameTop = 0
swApp.ActiveDoc.ActiveView.FrameState = 1
swApp.ActiveDoc.ActiveView.FrameState = 1
Set Part = swApp.ActiveDoc
Set SelMgr = Part.SelectionManager
boolstatus = Part.Extension.SelectByID2("前视", "PLANE", 0, 0, 0, False, 0, Nothing, 0) '进入前视基准面
Part.CreateCircle 0, 0, 0, Val(Text1.Text) * 0.001, 0, 0 '绘制圆，前三个坐标为圆心坐标，分别为X、Y、Z轴坐标，后三个为圆上一点坐标
Part.FeatureManager.FeatureExtrusion2 True, False, False, 0, 0, Val(Text2.Text) * 0.001, 0, False, False, False, False, 0, 0, False, False, False, False, 1, 1, 1, 0, 0, False
'拉伸命令，其中第六个参数为拉伸长度
boolstatus = Part.Extension.SelectByID2("", "FACE", 0, 0, Val(Text2.Text) * 0.001, False, 0, Nothing, 0)
'进入一个绘制基准面，其中基准面的Z周坐标为Val(Text2.Text) * 0.001
Part.SketchManager.InsertSketch True '插入一个草图
Part.CreateCircle 0, 0, 0, Val(Text3.Text) * 0.001, 0, 0
'绘制圆
Part.FeatureManager.FeatureCut True, False, False, 0, 0, Val(Text4.Text) * 0.001, 0, False, False, False, False, 0, 0, False, False, False, False, 0, 1, 1
'切除
boolstatus = Part.Extension.SelectByID2("", "FACE", 0, 0, Val(Text2.Text) * 0.001, False, 0, Nothing, 0)
Part.SketchManager.InsertSketch True
Part.CreateCircle Val(Text1.Text) * 0.001 - (Val(Text1.Text) * 0.001 - Val(Text3.Text) * 0.001) / 2, 0, Val(Text2.Text) * 0.001, Val(Text1.Text) * 0.001 - (Val(Text1.Text) * 0.001 - Val(Text3.Text) * 0.001) / 2 + 0.006, 0, Val(Text2.Text) * 0.001
Part.CreateCircularSketchStepAndRepeat Val(Text1.Text) * 0.001 - (Val(Text1.Text) * 0.001 - Val(Text3.Text) * 0.001) / 2, 3.14159265359, 4, 1.570796326795, 1, ""
Part.FeatureManager.FeatureExtrusion True, False, False, 0, 0, Val(Text2.Text) * 0.002, 0, False, False, False, False, 0, 0, False, False, False, False, 1, 1, 1
End Sub
下面的程序为驱动另外一个窗口，可以不需要
Private Sub Command2_Click()
End
End Sub
Private Sub Command3_Click()
Load Form2
Form2.Show
End Sub
__________________
借用达朗贝尔的名言：前进吧，你会得到信心!
[url="http://www.dimcax.com"]几何尺寸与公差标准[/url]
|
2011-03-15, 06:28 PM
平板模式
