几何尺寸与公差论坛------致力于产品几何量公差标准GD&T (GDT:ASME)|New GPS(ISO)研究/CAD设计/CAM加工/CMM测量

几何尺寸与公差论坛------致力于产品几何量公差标准GD&T (GDT:ASME)|New GPS(ISO)研究/CAD设计/CAM加工/CMM测量 (http://www.dimcax.com/hust/index.php)
-   SolidWorks二次开发 (http://www.dimcax.com/hust/forumdisplay.php?f=111)
-   -   【转帖】solidworks二次开发之零件篇-VB(原创) (http://www.dimcax.com/hust/showthread.php?t=33419)

huangyhg 2011-03-15 06:28 PM

【转帖】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

huangyhg 2011-03-15 06:29 PM

回复: 【转帖】solidworks二次开发之零件篇-VB(原创)
 
http://hi.baidu.com/lightning119/bl...340a6e538012f4f


所有的时间均为北京时间。 现在的时间是 09:55 AM.