Question

VB 对Solidworks进行二次开发，怎么编辑Solidworks录制的宏，然后再放入VB中？

我录制了一个画圆柱的宏，复制到commandbutton的click事件中，只能启动solidworks，却不能实现建模，请问怎么做？
宏程序如下：
Dim swApp As Object

Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long

Sub main()

Set swApp = _
Application.SldWorks

Set Part = swApp.NewDocument("C:\ProgramData\SolidWorks\SolidWorks 2010\templates\零件.prtdot", 0, 0, 0)
swApp.ActivateDoc2 "零件1", False, longstatus
Set Part = swApp.ActiveDoc
Dim myModelView As Object
Set myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
Set myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
Part.ClearSelection2 True
Dim skSegment As Object
Set skSegment = Part.SketchManager.CreateCircle(0#, 0#, 0#, 0.019126, 0.005847, 0#)
Part.ClearSelection2 True
Part.SketchManager.InsertSketch True
Part.ShowNamedView2 "*上下二等角轴测", 8
Part.ClearSelection2 True
boolstatus = Part.Extension.SelectByID2("草图1", "SKETCH", 0, 0, 0, False, 0, Nothing, 0)
Dim myFeature As Object
Set myFeature = Part.FeatureManager.FeatureExtrusion2(True, False, False, 0, 0, 0.02, 0.01, False, False, False, False, 0.01745329251994, 0.01745329251994, False, False, False, False, True, True, True, 0, 0, False)
Part.SelectionManager.EnableContourSelection = False
End Sub
我自己修改放入VB程序的是：
Private Sub Command1_Click()
Dim s As String
s = "C:\Program Files (x86)\SolidWorks Corp\SolidWorks\SLDWORKS.exe"
ShellExecute hwnd, "open", s, "", "", 0
Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Set swApp = CreateObject("SldWorks.Application")
Set Part = swApp.NewDocument("C:\ProgramData\SolidWorks\SolidWorks 2010\templates\零件.prtdot", 0, 0, 0)
swApp.ActivateDoc2 "零件1", False, longstatus
Set Part = swApp.ActiveDoc
Part.ClearSelection2 True
Dim skSegment As Object
Set skSegment = Part.SketchManager.CreateCircle(0#, 0#, 0#, 0.019126, 0.005847, 0#)
Part.ClearSelection2 True
Part.SketchManager.InsertSketch True
Part.ShowNamedView2 "*上下二等角轴测", 8
Part.ClearSelection2 True
boolstatus = Part.Extension.SelectByID2("草图1", "SKETCH", 0, 0, 0, False, 0, Nothing, 0)
Dim myFeature As Object
Set myFeature = Part.FeatureManager.FeatureExtrusion2(True, False, False, 0, 0, 0.02, 0.01, False, False, False, False, 0.01745329251994, 0.01745329251994, False, False, False, False, True, True, True, 0, 0, False)
Part.SelectionManager.EnableContourSelection = False
End Sub
运行VB，按下按钮，只能打开solidworks，却不能生成图。请问怎么修改？

Answer 1

试试这一个，我试过，可以的，如果还有问题的话，联系我

Dim swApp As SldWorks.SldWorks
Dim swPart As SldWorks.PartDoc
Dim boolstatus As Boolean
Dim warning As Long
Dim error As Long

Private Sub Command1_Click()

Set swApp = CreateObject("SldWorks.Application")
Set swPart = swApp.ActiveDoc
swApp.Visible = True
Set swPart = swApp.OpenDoc6("C:\Documents and Settings\All Users\Application Data\SolidWorks\SolidWorks 2010\templates\零件.prtdot", swDocPART, swOpenDocOptions_Silent, "", error, warning)

boolstatus = swPart.Extension.SelectByID2("前视基准面", "PLANE", 0, 0, 0, False, 0, Nothing, 0)
swPart.SketchManager.InsertSketch True
swPart.ClearSelection2 True
Dim skSegment As Object
Set skSegment = swPart.SketchManager.CreateCircle(0#, 0#, 0#, 0.034254, 0.010473, 0#)
swPart.ClearSelection2 True
swPart.SketchManager.InsertSketch True
swPart.ShowNamedView2 "*上下二等角轴测", 8
swPart.ClearSelection2 True
boolstatus = swPart.Extension.SelectByID2("草图1", "SKETCH", 0, 0, 0, False, 0, Nothing, 0)
Dim myFeature As Object
Set myFeature = swPart.FeatureManager.FeatureExtrusion2(True, False, False, 0, 0, 0.01, 0.01, False, False, False, False, 0.01745329251994, 0.01745329251994, False, False, False, False, True, True, True, 0, 0, False)
swPart.SelectionManager.EnableContourSelection = False

End Sub