SolidWorks API SelectByID2 方法

Question

有一种更有效的方法使用GetSelectedObjectCount()和GetSelectionPoint2()方法来获取可以与SelectByID2 方法。下面方法的问题是每个点的创建在特征树中既不省时也不整洁。一有时间就会更新这个帖子。

感谢您的理解。

我最近开始在 SolidWorks 中使用 VBA 进行一些编程，我想编写一个宏。现在的目标是从 selected 面和点（从边派生）创建一个参考平面。提醒一下，创建参考平面的方法是 InsertRefPlane，它需要 selection 通过 SelectByID2 方法完成。

到目前为止，我已经设法保存了面和点对象的句柄，但我还没有成功地使用 SelectByID2 方法。 selected 的对象变为 deselected。

value = instance.SelectByID2(Name, Type, X, Y, Z, Append, Mark, Callout, SelectOption)

我试过select只是一张脸，但我做不到。此外，我已经使用 SetEntityName 方法重命名了面部属性，并提供了它，但它没有设法 select 它。

能否请您分享一下如何创建参考平面的想法？不一定非要有脸和 edge/mid-point.

提前致谢。

编辑 1： 为了进一步说明，我向 selection 添加了两个对象（面和边），我想将它们正确地用于 select 具有 SelectByID2 的对象以用于 InsertRefPlane。我添加了下面的代码。

我的想法是：

我有面和边的手柄，但我可以将它们用于正确的 selection 和 SelectByID2 吗？
我可以在 selected 面和边缘上创建一个参考点来以某种方式识别面吗？
SelectByRay 似乎可行，但它需要对面法线进行一些计算，因此，如果可用，我会尝试一些其他“更简单”的方法。 编辑 2：我的脸不是平面的，所以我不能请求正常属性的脸。
Edit 3: 看来这一切都归结为识别对象名称和类型是解决问题的方法。这可能是一个解决方案，但我愿意接受另一个解决方案，如果可能的话会更容易。我们可以在使用适当的 Selection 方法之一时创建一个参考点，因为它们的名称是已知的，我们可以将它们用于 SelectbyID2 方法。完成后 post 解决方案。
关于 GetFaces/GetFirstFace/GetNextFace 方法，InsertRefPlane 需要通过 SelectByID2select 编辑对象

Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swPart As SldWorks.PartDoc
Dim swSelMgr As SldWorks.SelectionMgr
Dim swModelDocExt As SldWorks.ModelDocExtension
Dim swFeatMgr As SldWorks.FeatureManager

Dim selBool As Boolean
Dim longstatus As Long, longwarnings As Long

Sub main()

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swModelDocExt = swModel.Extension
Set swPart = swModel
Set swSelMgr = swModel.SelectionManager
Set swFeatMgr = swModel.FeatureManager

' Check which file is opened
Dim filePath As String: filePath = swModel.GetPathName()
Debug.Print "File path is:" & filePath

'   User has to select the face and the edge of the body to create plane and
'   sketch to convert face entities
' Gets selection from SelectionManager
Dim numSelectedObjs As Long
Dim selectionMark As Long: selectionMark = -1

numSelectedObjs = swSelMgr.GetSelectedObjectCount2(selectionMark)
Debug.Print "Number of selected objects:" & numSelectedObjs

Dim faceObj As SldWorks.Face2
Dim edgeObj As SldWorks.Edge
Dim midpointObj As Object

If (numSelectedObjs > 0) Then
    ' Get and validate selection
    Dim selObj As Object
    Dim selObjIndex As Long
    Dim selObjType As Long
    For selObjIndex = 1 To numSelectedObjs ' This method uses 1 as first index
        selObjType = swSelMgr.GetSelectedObjectType3(selObjIndex, selectionMark)
        ' Check selected object type and assign it to appropriate variable
        If (selObjType = SwConst.swSelFACES) Then
            Set faceObj = swSelMgr.GetSelectedObject6(selObjIndex, selectionMark)
            Dim faceFeat As Object
            Set faceFeat = faceObj.GetFeature()
        ElseIf (selObjType = SwConst.swSelEDGES) Then
            Set edgeObj = swSelMgr.GetSelectedObject6(selObjIndex, selectionMark)
            swModel.SelectMidpoint ' With this line, we add point to selection, increasing the count to 3
            Dim deselVal As Long
            deselVal = swSelMgr.DeSelect2(selObjIndex, selectionMark) ' Deselect the edge
            Set midpointObj = swSelMgr.GetSelectedObject6(selObjIndex, selectionMark) ' Set the object to the point
        Else
            MsgBox "Wrong objects selected, select only face and edge"
            Exit For
        End If
    Next
End If

' Create reference plane using face and a point
' InsertRefPlane method requires selection using SelectByID2 Method

Dim objName, objType As String: objName = "": objType = SwConst.swSelectType_e.swSelFACES
Dim X, Y, Z As Double: X = 0: Y = 0: Z = 0
Dim selAppend As Boolean: selAppend = True
Dim objMark As Long: objMark = 0
Dim objCallout As Callout
Dim selOption As swSelectOption_e: selOption = 0

selBool = swModel.Extension.SelectByID2(objName, objType, X, Y, Z, selAppend, objMark, objCallout, selOption)
Debug.Print selBool

Answer 1

我不为你工作的原因可能有很多。没有你完整的代码，很难帮到你。

如果您的 selection 被删除select，可能是因为您将“Attempt”设置为 False。此外，第一个 selection 的“Mark”需要为“0”，第二个需要为“1”。看InsertRefPlane

中的备注和例子

获得代码基础的最佳方法是开始录制宏，手动插入平面，然后停止并编辑代码。

此外，SelectByID2 并不是 select 一张脸的唯一方法，还有 SelectByRay, or cycle through all the entities with GetFirstFace / GetNextFace or GetFaces 可以找到你想要的那个。

Answer 2

大部分细节都在我的问题中，最后编辑的是我如何解决它。方法是：

从 SelectionManager 获取对象（如面或边）的句柄
创建所选对象的实体对象，这允许您使用 Select4 方法
现在您可以创建参考几何图形，并获得可以与 SelectByID2 方法一起使用的名称属性

我在另一个型号上试过了，但不能保证它也适用于你。

' PREREQUISITES:
'   User has to select the face and the edge of the body to create plane and
'   sketch to convert face entities to it

Sub main()

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swModelDocExt = swModel.Extension
Set swPart = swModel
Set swSelMgr = swModel.SelectionManager
Set swFeatMgr = swModel.FeatureManager
Set swSelData = swSelMgr.CreateSelectData
' Check which file is opened
Dim filePath As String: filePath = swModel.GetPathName()
Debug.Print "File path is:" & filePath


' Gets selection from SelectionManager
Dim numSelectedObjs As Long
Dim selectionMark As Long: selectionMark = -1

numSelectedObjs = swSelMgr.GetSelectedObjectCount2(selectionMark)
Debug.Print "Number of selected objects:" & numSelectedObjs

Dim faceObj As SldWorks.Face2

Dim edgeObj As SldWorks.Edge
Dim vEdges, vEdge As Variant
Dim nEdges As Long
Dim edgeEntityPairs(999), tempEdgeEntity(99, 99) As Variant

Dim loopObj As SldWorks.Loop2
Dim vLoops, vLoop As Variant
Dim nLoops, nLoop As Long

Dim counter(99) As Long

If (numSelectedObjs = 2) Then
    ' Get and validate selection
    Dim selObj As Object
    Dim selObjIndex As Long
    Dim selObjType As Long
    For selObjIndex = 1 To numSelectedObjs ' This method uses 1 as first index
        selObjType = swSelMgr.GetSelectedObjectType3(selObjIndex, selectionMark)
        Debug.Print "Selected obj type:" & selObjType
        ' Check selected object type and assign it to appropriate variable
        If (selObjType = SwConst.swSelFACES) Then ' Face
            Set faceObj = swSelMgr.GetSelectedObject6(selObjIndex, selectionMark)
            Set faceEntity = faceObj
            vLoops = faceObj.GetLoops()
            nLoops = faceObj.GetLoopCount()
            ' This loop gets the each loop(SW) object and its edges
            For Each vLoop In vLoops
                ' To do: Check if there's only single loop on the face
                Set loopObj = vLoop
                nEdges = loopObj.GetEdgeCount()
                vEdges = loopObj.GetEdges()
                For Each vEdge In vEdges
                    Set edgeObj = vEdge
                    Set tempEdgeEntity(nLoop, counter(nLoop)) = edgeObj
                    counter(nLoop) = counter(nLoop) + 1
                Next
                nLoop = nLoop + 1
            Next
        ElseIf (selObjType = SwConst.swSelEDGES) Then ' Edge
            Set edgeObj = swSelMgr.GetSelectedObject6(selObjIndex, selectionMark)
            Set edgeEntity = edgeObj
        Else
            MsgBox "Wrong type of objects selected, select only face and edge"
            Exit For
        End If
    Next
Else
MsgBox "Wrong number of objects selected"
   Stop
End If

'
swModel.ClearSelection2 (True)
Debug.Print "Selection cleared"
selBool = edgeEntity.Select4(True, swSelData)
'Debug.Print "Edge selected - " & selBool

Dim surfaceMidpoint, edgeMidpoint As Variant
Dim surfaceMidpointString, edgeMidpointString As String

edgeMidpoint = swFeatMgr.InsertReferencePoint(2, 1, 50, 1) ' Edge midpoint
edgeMidpointString = edgeMidpoint(0).Name

'''''' To create a reference plane from face and its midpoint
'''''swModel.ClearSelection2 (True)
'''''selBool = faceEntity.Select4(True, swSelData)
'''''Debug.Print "Face selected - " & selBool
'''''
'''''surfaceMidpoint = swModel.FeatureManager.InsertReferencePoint(4, 1, 50, 1) ' Surface midpoint
'''''surfaceMidpointString = surfaceMidpoint(0).Name

'' Create 3 points from 6 edges by intersection for a reference plane
' Get an edge and the one adjacent to it to create a point by InsertReferencePoint method

' Loop that traverses through lists of loop objs, edge entities to
' filter out empty elements
' To do: handle cases where the first loop is the outer one and it has odd number
'        of edges, if there are inner loops such as holes that have 2 edges each
'        it is not possible to find an intersection point on those edges

kk = 0 ' kk is the number of found edges
For i = 0 To nLoops
    For k = 0 To 99
        If (Not IsEmpty(tempEdgeEntity(i, k))) Then
            Set edgeEntityPairs(kk) = tempEdgeEntity(i, k)
            kk = kk + 1
        End If
    Next
Next


Dim intersectPoint(2) As Variant
Dim intersectPointString(2) As String

' This If statement needs to be more robust, haven't encountered issues
' but there might be some. It is possible to find the outer loop and
' obtain enough points for reference plane just from it
If (kk = 4) Then
    ' Case where there's only a face that contains 1 loop with 4 edges
    swModel.ClearSelection2 (True)
    selBool = edgeEntityPairs(0).Select4(True, swSelData)
    selBool = edgeEntityPairs(1).Select4(True, swSelData)
    intersectPoint(0) = swFeatMgr.InsertReferencePoint(6, 1, 50, 1) ' Edges intersection
    swModel.ClearSelection2 (True)
    selBool = edgeEntityPairs(1).Select4(True, swSelData)
    selBool = edgeEntityPairs(2).Select4(True, swSelData)
    intersectPoint(1) = swFeatMgr.InsertReferencePoint(6, 1, 50, 1) ' Edges intersection
    swModel.ClearSelection2 (True)
    selBool = edgeEntityPairs(2).Select4(True, swSelData)
    selBool = edgeEntityPairs(3).Select4(True, swSelData)
    intersectPoint(2) = swFeatMgr.InsertReferencePoint(6, 1, 50, 1) ' Edges intersection
    swModel.ClearSelection2 (True)
Else
    ' Case when there are multiple loops and when the first loop is a
    ' a hole that contains two edges
    swModel.ClearSelection2 (True)
    selBool = edgeEntityPairs(0).Select4(True, swSelData)
    selBool = edgeEntityPairs(1).Select4(True, swSelData)
    intersectPoint(0) = swFeatMgr.InsertReferencePoint(6, 1, 50, 1) ' Edges intersection
    swModel.ClearSelection2 (True)
    selBool = edgeEntityPairs(2).Select4(True, swSelData)
    selBool = edgeEntityPairs(3).Select4(True, swSelData)
    intersectPoint(1) = swFeatMgr.InsertReferencePoint(6, 1, 50, 1) ' Edges intersection
    swModel.ClearSelection2 (True)
    selBool = edgeEntityPairs(4).Select4(True, swSelData)
    selBool = edgeEntityPairs(5).Select4(True, swSelData)
    intersectPoint(2) = swFeatMgr.InsertReferencePoint(6, 1, 50, 1) ' Edges intersection
    swModel.ClearSelection2 (True)
End If

' Create reference plane using 3 points
intersectPointString(0) = intersectPoint(0)(0).Name
intersectPointString(1) = intersectPoint(1)(0).Name
intersectPointString(2) = intersectPoint(2)(0).Name

' Selecting the points
For p = 0 To 2
    If (p = 0) Then
        selBool = swModel.Extension.SelectByID2(intersectPointString(p), "DATUMPOINT", 0, 0, 0, False, 0, Nothing, 0)
    Else
        selBool = swModel.Extension.SelectByID2(intersectPointString(p), "DATUMPOINT", 0, 0, 0, True, p, Nothing, 0)
    End If
Next

' Creating the reference plane
Dim refPlaneObj As Object
Dim firstCon As Long: firstCon = SwConst.swRefPlaneReferenceConstraint_Coincident
Dim firstConVal As Long: firstConVal = 0
Dim secondCon As Long: secondCon = SwConst.swRefPlaneReferenceConstraint_Coincident
Dim secondConVal As Long: secondConVal = 0
Dim thirdCon As Long: thirdCon = SwConst.swRefPlaneReferenceConstraint_Coincident
Dim thirdConVal As Long: thirdConVal = 0
Set refPlaneObj = swModel.FeatureManager.InsertRefPlane(firstCon, firstConVal, _
                                                        secondCon, secondConVal, _
                                                        thirdCon, thirdConVal)

' Convert face entity to the sketch on the new plane
Dim refPlaneEntity As SldWorks.Entity
Set refPlaneEntity = refPlaneObj
swModel.ClearSelection2 (True)
selBool = refPlaneEntity.Select4(True, swSelData)
swModel.SketchManager.InsertSketch (True)
selVal = faceEntity.Select4(True, swSelData)
boolstatus = swModel.SketchManager.SketchUseEdge3(False, False)
swModel.SketchManager.InsertSketch True
End Sub

Answer 3

Actually it looks like there might be issues because the CAD model is imported and faces are faces are non-planar.

嗨马里奥，

您可以使用以下方法检查所选面是否为平面：

Face.IGetSurface().IsPlane()

埃迪

SolidWorks API SelectByID2 方法

SolidWorks API SelectByID2 method

api

vba

solidworks