SolidWorks API SelectByID2 方法

Question

有一種更有效的方法，使用GetSelectedObjectCount()和GetSelectionPoint2()方法來獲取可與 SelectByID2 方法一起使用的點。 下面方法的問題是每個點的創建在特征樹中既不省時也不整潔。 一旦我有時間會更新這個線程。

謝謝你的理解。

---

我最近開始在 VBA 在 SolidWorks 中進行一些編程，我正在尋找編寫宏的方法。 現在的目標是從選定的面和點（從邊派生）創建一個參考平面。 提醒一下，創建參考平面的方法是InsertRefPlane，需要通過SelectByID2方法進行選擇。

到目前為止，我已經設法保存了面和點對象的句柄，但我還沒有成功地使用 SelectByID2 方法。 已選擇的對象變為取消選擇。

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

我試過 select 只是一張臉，但我做不到。 此外，我已經使用 SetEntityName 方法重命名了 face 屬性，並提供了它，但它並沒有成功到 select。

您能否分享一下如何創建參考平面的想法？ 不一定非要有面和邊/中點。

先感謝您。

編輯 1：為了進一步說明，我在選擇中添加了兩個對象（面和邊），我想將它們正確地用於帶有 SelectByID2 的 select 對象以用於 InsertRefPlane。 我已經添加了下面的代碼。

我的想法是：

• 我有面和邊的句柄，但我可以使用它們通過 SelectByID2 進行正確選擇嗎？

• 我可以在選定的面和邊上創建參考點以某種方式識別面嗎？

• SelectByRay 似乎可行，但它需要對面法線進行一些計算，因此，如果可用，我會嘗試一些其他“更簡單”的方法。 編輯 2 ：我有非平面的臉，所以我不能請求臉部的 Normal 屬性。

• 編輯 3 ：似乎這一切都歸結為識別 object 名稱和類型是解決問題的方法。 這可能是一個解決方案，但我願意接受另一個解決方案，如果可能的話會更容易。 我們可以在使用適當的 Selection 方法之一時創建一個參考點，因為它們的名稱是已知的，我們可以將它們用於 SelectbyID2 方法。 完成后將發布解決方案。

• 關於 GetFaces/GetFirstFace/GetNextFace 方法， InsertRefPlane需要通過 SelectByID2 選擇對象

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

實際上看起來可能存在問題，因為導入了 CAD model 並且面是非平面的。

嗨馬里奧，

您可以使用以下方法檢查所選面是否為平面：

Face.IGetSurface().IsPlane()

渦流

Answer 2

我不為你工作的原因可能有很多。 如果沒有完整的代碼，將很難為您提供幫助。

如果您的選擇被取消選擇，可能是因為您將“嘗試”設置為 False。 此外，第一個選擇的“Mark”需要為“0”，第二個選擇為“1”。 看InsertRefPlane中的備注和例子

獲得代碼基礎的最佳方法是開始錄制宏，手動插入一個平面，然后停止並編輯代碼。

此外， SelectByID2 不是選擇人臉的唯一方法，還有SelectByRay ，或使用GetFirstFace / GetNextFace或GetFaces循環遍歷所有實體以找到您想要的人。

Answer 3

大多數細節都在我的問題中，最后一次編輯是我如何解決它。 這樣做的方法是：

1. 從 SelectionManager 獲取對象的句柄（例如面或邊）
2. 創建所選對象的 Entity 對象，這允許您使用 Select4 方法
3. 現在您可以創建參考幾何圖形，並獲得可以與 SelectByID2 方法一起使用的 Name 屬性

我在另一個模型上試過了，但不能保證它也適合你。

' 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