新手求助，用SelectByID2命令总是选错边线 - iCAx开思网

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 2016\templates\gb_part.prtdot", 0, 0, 0)
swApp.ActivateDoc2 "零件4", False, longstatus
Set Part = swApp.ActiveDoc
Dim myModelView As Object
Set myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized
swApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swInputDimValOnCreate, False
boolstatus = Part.Extension.SelectByID2("右视基准面", "PLANE", 0, 0, 0, False, 0, Nothing, 0)
Part.SketchManager.InsertSketch True
Dim skSegment As Object
Set skSegment = Part.SketchManager.CreateCircle(-0#, 0#, 0#, -0.045, 0, 0#)
Dim myDisplayDim As Object
Set myDisplayDim = Part.AddDimension2(0, 0, 0.09)
Dim myDimension As Object
Set myDimension = Part.Parameter("D1@草图1")
myDimension.SystemValue = 0.09
Part.SketchManager.InsertSketch True
boolstatus = Part.Extension.SelectByID2("草图1", "SKETCH", 0, 0, 0, False, 4, Nothing, 0)
Dim myFeature As Object
Set myFeature = Part.FeatureManager.FeatureExtrusion2(True, False, False, 0, 0, 0.41, 0.01, False, False, False, False, 0, 0, False, False, False, False, True, True, True, 0, 0, False)
Part.SelectionManager.EnableContourSelection = False
Part.ViewZoomtofit2
boolstatus = Part.Extension.SelectByID2("", "FACE", 0.41, 0, 0, False, 0, Nothing, 0)
Part.SketchManager.InsertSketch True
Set skSegment = Part.SketchManager.CreateCircle(0#, 0#, 0#, -0.0475, 0, 0#)
Set myDisplayDim = Part.AddDimension2(0.41, 0, 0.095)
Set myDimension = Part.Parameter("D1@草图2")
myDimension.SystemValue = 0.095
Part.SketchManager.InsertSketch True
Set myFeature = Part.FeatureManager.FeatureExtrusion2(True, False, False, 0, 0, 0.24, 0.41, False, False, False, False, 0, 0, False, False, False, False, True, True, True, 0, 0, False)
Part.SelectionManager.EnableContourSelection = False
Part.ViewZoomtofit2
'*******************************************************************************************************************************************************************************
'总是不能选中正确的边线，命令中的那三个数值是边线上某一点的坐标
boolstatus = Part.Extension.SelectByID2("", "EDGE", 0.41, 0, 0.0475, True, 0, Nothing, 0)
Set myFeature = Part.FeatureManager.InsertFeatureChamfer(4, 1, 0.001, 0.78539816339745, 0, 0, 0, 0)
boolstatus = Part.DeSelectByID("倒角1", "BODYFEATURE", 0, 0, 0)
boolstatus = Part.Extension.SelectByID2("", "EDGE", 0.41, 0, 0.045, True, 1, Nothing, 0)
'********************************************************************************************************************************************************************************
Dim radiiArray3 As Variant
Dim radiis3 As Double
Dim dist2Array3 As Variant
Dim dists23 As Double
Dim conicRhosArray3 As Variant
Dim coniRhos3 As Double
Dim setBackArray3 As Variant
Dim setBacks3 As Double
Dim pointArray3 As Variant
Dim points3 As Double
Dim pointDist2Array3 As Variant
Dim pointsDist23 As Double
Dim pointRhoArray3 As Variant
Dim pointsRhos3 As Double
radiiArray3 = radiis3
dist2Array3 = dists23
conicRhosArray3 = coniRhos3
setBackArray3 = setBacks3
pointArray3 = points3
pointDist2Array3 = pointsDist23
pointRhoArray3 = pointsRhos3
Set myFeature = Part.FeatureManager.FeatureFillet3(195, 0.001, 0.01, 0, 0, 0, 0, (radiiArray3), (dist2Array3), (conicRhosArray3), (setBackArray3), (pointArray3), (pointDist2Array3), (pointRhoArray3))
swApp.SetUserPreferenceToggle swUserPreferenceToggle_e.swInputDimValOnCreate, True
End Sub

复制代码