There is a more efficient method using the GetSelectedObjectCount() and GetSelectionPoint2() methods to obtain the points that can be used with SelectByID2 method. The issue of the method below is that creation of each point is not time efficient nor tidy in the feature tree. Will update this thread once I have time.
Thank you for understanding.
I recently started some programming in VBA in SolidWorks and I am looking to write a macro. The goal for now is to create a reference plane from selected face and point(deriving it from edge). As a reminder, method to create the reference plane is InsertRefPlane, which requires the selection to be done by SelectByID2 method.
So far I've managed to save the handle for the face and point objects, but I haven't managed to successfully use the SelectByID2 method. Objects that were selected become deselected.
value = instance.SelectByID2(Name, Type, X, Y, Z, Append, Mark, Callout, SelectOption)
I have tried select just a face, but I couldn't manage to do it. Also, I have renamed the face property using the SetEntityName method, and supplied it as well, but it did not manage to select it.
Could you please share the ideas how to do create a reference plane? It doesn't have to be necessary a face and an edge/mid-point.
Thank you in advance.
Edit 1: For further clarification, I have added two objects (face and edge) to selection and I would like to use those to properly select objects with SelectByID2 to use for InsertRefPlane. I have added the code below.
Ideas that I have are:
I have handles to the face and the edge, but can I use those for proper selection with SelectByID2?
Can I create a reference points on the selected face and edge to identify the face somehow?
SelectByRay seems feasible, but it would require some calculations with face normals so, I would try some other "simpler" methods if available. Edit 2: I have non-planar face so I can't request Normal property of the face.
Edit 3: It seems that it all comes down to identifying an object name and type is the way to solve the problem. This is probably a solution, but I'm open for another one, easier if possible. We can create a reference points when using one of appropriate Selection methods, because their names are known, we can use those for SelectbyID2 method. Will post the solution once I am done.
Regarding the GetFaces/GetFirstFace/GetNextFace methods, InsertRefPlane requires objects to be selected by 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
3 Answers
The most of the details are in my question and the last edit is the how I solved it. The way to do it is to:
- Obtain a handle to the object (such as face or edge) from the SelectionManager
- Create an Entity object of the selected object, this allows you to use Select4 methods
- Now you can create reference geometry, and you obtain the Name property which you can use with SelectByID2 method
I tried it out on another model, but can't guarantee it will work for you as well.
' 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
Actually it looks like there might be issues because the CAD model is imported and faces are faces are non-planar.
Hi Mario,
You can check if the selected face is planar by using:
Face.IGetSurface().IsPlane()
Eddy
There could be many reasons why I doesn't work for you. Without your complete code, it would be difficult to help you.
If your selection get deselected, it might be because you set "Attempt" to False. Also "Mark" needs to be "0" for the first selection, and "1" for the second. Look at the remarks and examples in InsertRefPlane
The best way to get a base for your code is to start recording a macro, manually insert a plane then stop and edit the code.
Also SelectByID2 is not the only method to select a face, there is also SelectByRay, or cycle through all the entities with GetFirstFace / GetNextFace or GetFaces to find the one you want.
