swxjrnl.swj

使用VB对SolidWorks进行的二次开发。主要是建立了一个螺纹标准件库以及螺纹计算方法。

' ******************************************************************************
' swxJRNL.swj - journal recorded on 06/01/05 by Fort
' *****************************************************************************
Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Dim FeatureData As Object
Dim Feature As Object
Dim Component As Object
Sub main()

Set swApp = Application.SldWorks

Set Part = swApp.OpenDoc6 ("E:\Design\Fort\Res\双头螺柱A型.SLDPRT", 1, 0, "", longstatus, longwarnings)
Set Part = swApp.ActivateDoc ("双头螺柱A型")
swApp.ActiveDoc.ActiveView.FrameLeft = 0
swApp.ActiveDoc.ActiveView.FrameTop = 0
swApp.ActiveDoc.ActiveView.FrameState = 1
swApp.ActiveDoc.ActiveView.FrameState = 1
boolstatus = Part.Extension.SelectByID("草图1", "SKETCH", 0, 0, 0, False, 0, Nothing)
Part.EditSketch
Part.ClearSelection2 True
Part.InsertSketch2 True
Part.ShowNamedView2 "*等轴测", 7
boolstatus = Part.Extension.SelectByID("草图1", "SKETCH", 0, 0, 0, False, 0, Nothing)
Part.ActivateSelectedFeature
Part.ClearSelection2 True
boolstatus = Part.Extension.SelectByID("草图1", "SKETCH", 0, 0, 0, False, 0, Nothing)
Part.EditSketch
Part.ClearSelection2 True
Part.InsertSketch2 True
boolstatus = Part.Extension.SelectByID("拉伸1", "BODYFEATURE", 0, 0, 0, False, 0, Nothing)
Part.ActivateSelectedFeature
boolstatus = Part.Extension.SelectByID("拉伸1", "BODYFEATURE", 0, 0, 0, False, 0, Nothing)
Part.ClearSelection2 True
boolstatus = Part.Extension.SelectByID("草图2", "SKETCH", 0, 0, 0, False, 0, Nothing)
Part.EditSketch
Part.ClearSelection2 True
Part.InsertSketch2 True
boolstatus = Part.Extension.SelectByID("拉伸2", "BODYFEATURE", 0, 0, 0, False, 0, Nothing)
Part.ClearSelection2 True
boolstatus = Part.Extension.SelectByID("草图3", "SKETCH", 0, 0, 0, False, 0, Nothing)
boolstatus = Part.Extension.SelectByID("草图4", "SKETCH", 0, 0, 0, False, 0, Nothing)
boolstatus = Part.Extension.SelectByID("草图5", "SKETCH", 0, 0, 0, False, 0, Nothing)
boolstatus = Part.Extension.SelectByID("草图6", "SKETCH", 0, 0, 0, False, 0, Nothing)
boolstatus = Part.Extension.SelectByID("草图6", "SKETCH", 0, 0, 0, False, 0, Nothing)
Part.ActivateSelectedFeature
boolstatus = Part.Extension.SelectByID("草图6", "SKETCH", 0, 0, 0, False, 0, Nothing)
Part.EditSketch
Part.ClearSelection2 True
Part.InsertSketch2 True
Part.ShowNamedView2 "*等轴测", 7
boolstatus = Part.Extension.SelectByID("草图6", "SKETCH", 0, 0, 0, False, 0, Nothing)
boolstatus = Part.Extension.SelectByID("螺旋线1", "REFERENCECURVES", 0, 0, 0, False, 0, Nothing)
Part.ClearSelection2 True
Part.ClearSelection2 True
boolstatus = Part.Extension.SelectByID("倒角1", "BODYFEATURE", 0, 0, 0, False, 0, Nothing)
' MSGBOX
' 将改动保存到 双头螺柱A型？

Part.ClearSelection2 True
Set Part = Nothing
swApp.CloseDoc "双头螺柱A型"
Set Part = swApp.OpenDoc6 ("E:\Design\Fort\Res\双头螺柱B型.SLDPRT", 1, 0, "", longstatus, longwarnings)
Set Part = swApp.ActivateDoc ("双头螺柱B型")
swApp.ActiveDoc.ActiveView.FrameLeft = 0
swApp.ActiveDoc.ActiveView.FrameTop = 0
swApp.ActiveDoc.ActiveView.FrameState = 1
swApp.ActiveDoc.ActiveView.FrameState = 1
swApp.ActiveDoc.ActiveView.FrameState = 1
swApp.ExitApp
End Sub