AnsweredAssumed Answered

Confirm a point is on a surface

Question asked by Arlene Garfield on Nov 18, 2019
Latest reply on Nov 19, 2019 by Arlene Garfield

the end goal is to create a plane tangent to a surface at a point.  The Macro will successfully final and select Faces 1 at a time.  It can find all points and will go through them 1 at a time.  So now I want to confirm if the point is on the currently selected face. If it is I want it to then create a ref. plane tang. at that point on that face, then move on to the next point/face. 

On screen I can see it go through things and select them. But the check returns "Not On Face" for all points even though is have in fact selected a Point that is on a Selected face.  I double checked and the point in the sketch is mated to the surface.

 

Whole code "There is junk in dim area that I have not cleaned out."

Dim swApp As Object
Dim swPart As Object
Dim boolstatus As Boolean
Dim bool As Boolean
Dim longstatus As Long, longwarnings As Long
Dim swModel As SldWorks.ModelDoc2
Dim swSelMgr As SelectionMgr
Dim swSelData As SelectData
Dim swModelDocExt As ModelDocExtension
Dim All As Boolean


'Surf
Dim swFace As SldWorks.Face2
Dim currface As Integer
Dim retval As Variant
Dim i As Integer
Dim obj As Object
Dim TrackingCookie As Integer
Dim TrackingIDs As Object
Dim value As Integer

'Point
Dim swSketch As SldWorks.Sketch
Dim swSketchMgr As SldWorks.SketchManager
Dim swSketchPt As SldWorks.SketchPoint
Dim Count As Long
Dim vID As Variant
Dim vSketchUserPt As Variant
Dim vSketchPt As Variant
Dim vSketchPtID As Variant
Dim point As Variant
Dim p As Integer
Dim retvalP As Variant

'plane
Dim swFeatMgr As FeatureManager
Dim swRefPlane As Object

'create entity
Dim enF As Entity
Dim enP As Entity
Dim data As SelectData
Dim mathUtils As MathUtility
Dim Mpt As MathPoint
Dim swPoint(2) As Double
Dim swArr As Variant

'MARKS
Public mark As Long
Public mark2 As Long
Dim lMark As Long
Dim lMarkedIdx As Long
Dim lNumMarkedSelections As Long
Dim lNumAllSelections As Long


Sub main()

'Connect to Solidworks
Set swApp = Application.SldWorks

'get active swModel
Set swModel = swApp.ActiveDoc
Set swPart = swModel
swModel.ClearSelection2 (All)
Set swFeatMgr = swModel.FeatureManager
Set swSelMgr = swModel.SelectionManager
Set swSelData = swSelMgr.CreateSelectData

'Set the marks for the selections and selection boxes
mark = 1
mark2 = 2

'point sketch
'Tell user to rename point sketch
'MsgBox "Name sketch with desired pad points: HoleLocP"

' Get SketchManager
Set swSketchMgr = swModel.SketchManager
Set swModelDocExt = swModel.Extension
Set mathUtils = swApp.GetMathUtility()

' Clear the selection
swModel.ClearSelection2 (All)


' Select the sketch
boolstatus = swModelDocExt.SelectByID2("HoleLocP", "SKETCH", 0, 0, 0, False, 5, Nothing, 0)
Debug.Print "SKETCH exsist = " & boolstatus

'GET NUMBER OF SELECTED ITEMS
'lNumAllSelections = swModel.SelectionManager.GetSelectedObjectCount
'Debug.Print "Current number of selected Items after sketch: " & lNumAllSelections


' Activate the sketch
swSketchMgr.Insert3DSketch True

' Get the sketch itself
Set swSketch = swModel.GetActiveSketch2

'Get number of points in sketch
Count = swSketch.GetSketchPointsCount2
'Debug.Print "Point Count " & Count

'closes sketch
swSketchMgr.Insert3DSketch False

'Rename Surfaces
currface = 1

If Not swPart Is Nothing Then

retval = swPart.GetBodies2(-1, True)

For i = 0 To UBound(retval)

Dim swBody As Body2

Set swBody = retval(i)

'Debug.Print swBody.Name

Set swFace = swBody.GetFirstFace

'end when no more faces
Do While Not swFace Is Nothing 'Selections for top selection box
boolstatus = swModelDocExt.SelectByID2("", "FACE", 0, 0, 0, False, mark, Nothing, 0)

boolstatus = swPart.DeleteEntityName(swFace) '************************ remove or comment out if you don't want to accidentally rename your faces in the future.

boolstatus = swPart.SetEntityName(swFace, "Surf" & currface)

'GET NUMBER OF SELECTED ITEMS
lNumAllSelections = swModel.SelectionManager.GetSelectedObjectCount
Debug.Print "Current number of selected Items after face: " & lNumAllSelections

'Get Point selection
vSketchPt = swSketch.GetSketchPoints2

'Set vSketchPt = retvalP
For p = 0 To UBound(vSketchPt)
Set swSketchPt = vSketchPt(p)

swFace.Select4 False, swSelData

'selects current point
bRet = swSketchPt.Select4(True, swSelData)


'GET NUMBER OF SELECTED ITEMS
lNumAllSelections = swModel.SelectionManager.GetSelectedObjectCount
Debug.Print "Current number of selected Items after point: " & lNumAllSelections


'BEGINNING  OF CONFIRMING POINT IS ON FACE.  AT THIS POINT A SURF IS SELECTED FROM ABOVE.
swPoint(0) = swSketchPt.X

swPoint(1) = swSketchPt.X

swPoint(2) = swSketchPt.X

swArr = swPoint

Set Mpt = mathUtils.CreatePoint(swArr)

Dim rayVector As MathVector

Dim pointdir(2) As Double

Dim vArr As Variant

pointdir(0) = 1

pointdir(1) = 1

pointdir(2) = 1

vArr = pointdir

Set rayVector = mathUtils.CreateVector(vArr)

Dim InterSectpoint As MathPoint

'MsgBox ("surface :" & swPart.GetEntityName(swFace))

Set InterSectpoint = swFace.GetProjectedPointOn(Mpt, rayVector)

If InterSectpoint Is Nothing Then

MsgBox "Point is not on the selected face"

Else
MsgBox "Point is on selected Face"
'Set swRefPlane = swFeatMgr.InsertRefPlane(32, 0, 4, 0, 0, 0)
End If

vSketchPtID = swSketchPt.GetID
Debug.Print " IDPt(" & p + 1 & ") = [" & vSketchPtID(0) & ", " & vSketchPtID(1) & "]"
point = "Point" & p + 1 & "@" & swSketch.Name
Debug.Print point

'debug print information
Debug.Print "SKETCH Name = " & swSketch.Name
Debug.Print "current surf: " & swPart.GetEntityName(swFace)
Debug.Print point

'MsgBox (point & " " & swPart.GetEntityName(swFace))

'Set swRefPlane = swFeatMgr.InsertRefPlane(32, 0, 4, 0, 0, 0)


Next p

Debug.Print ""
'Set swApp = Nothing

' Get face object

Set swFace = swFace.GetNextFace

currface = currface + 1

Loop

Next i

End If



End Sub

Outcomes