Looking for API call or VBA example of how to extract the midpoint coordinates of a sketch segment, whether a line, arc, spline, etc.
Looking for API call or VBA example of how to extract the midpoint coordinates of a sketch segment, whether a line, arc, spline, etc.
This works on sketch segments.
'-------------------------------------------------------
' Preconditions:
' 1. Open a part document.
' 2. Select an edge.
' 3. Open the Immediate window.
'
' Postconditions:
' 1. Puts a midpoint on the selected edge.
' 2. Place the cursor on the selected edge to see the
' midpoint.
' 3. Examine the Immediate window.
'------------------------------------------------------
Option Explicit
Const swSelEDGES As Long = 1
Const swSelREFERENCECURVES As Long = 26
Const swSelPOINTREFS As Long = 41
Const swSelREFEDGES As Long = 51
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swPart As SldWorks.PartDoc
Dim swSelMgr As SldWorks.SelectionMgr
Dim nSelType As Long
Set swApp = CreateObject("SldWorks.Application")
Set swModel = swApp.ActiveDoc
Set swPart = swModel
Set swSelMgr = swModel.SelectionManager
nSelType = swSelMgr.GetSelectedObjectType3(1, -1)
Debug.Print "SelType (before) = " + Str(nSelType)
swModel.SelectMidpoint
nSelType = swSelMgr.GetSelectedObjectType3(1, -1)
Debug.Print "SelType (after ) = " + Str(nSelType)
End Sub
This works great. Thank you. Now I just need to figure out how to capture the coordinates of the selected point. I have some ideas on how to do this but if you have any further recommendations that would be great also.
Eric
I added code to the bottom for measuring the point coordinates. I think this will do it.
Option Explicit
Const swSelEDGES As Long = 1
Const swSelREFERENCECURVES As Long = 26
Const swSelPOINTREFS As Long = 41
Const swSelREFEDGES As Long = 51
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swPart As SldWorks.PartDoc
Dim swSelMgr As SldWorks.SelectionMgr
Dim nSelType As Long
Set swApp = CreateObject("SldWorks.Application")
Set swModel = swApp.ActiveDoc
Set swPart = swModel
Set swSelMgr = swModel.SelectionManager
nSelType = swSelMgr.GetSelectedObjectType3(1, -1)
Debug.Print "SelType (before) = " + Str(nSelType)
swModel.SelectMidpoint
nSelType = swSelMgr.GetSelectedObjectType3(1, -1)
Debug.Print "SelType (after ) = " + Str(nSelType)
'Measure Point
Dim status As Boolean
Dim swMeasure As SldWorks.Measure
Dim swModelDocExt As SldWorks.ModelDocExtension
Set swModelDocExt = swModel.Extension
Set swMeasure = swModelDocExt.CreateMeasure
status = swMeasure.Calculate(Nothing)
Debug.Print "X coordinate: " & swMeasure.X / 0.0254
Debug.Print "Y coordinate: " & swMeasure.Y / 0.0254
Debug.Print "Z coordinate: " & swMeasure.Z / 0.0254
swModel.ClearSelection2 True
End Sub
That should do it (Well done! ) but you can also get the selected entity. It's sketchpoint and it has an X, Y and Z properties.
Thanks again. I actually tried that first unsucessfully. Wasnt quite sure of the sequence of steps.
This works on sketch segments.
'-------------------------------------------------------
' Preconditions:
' 1. Open a part document.
' 2. Select an edge.
' 3. Open the Immediate window.
'
' Postconditions:
' 1. Puts a midpoint on the selected edge.
' 2. Place the cursor on the selected edge to see the
' midpoint.
' 3. Examine the Immediate window.
'------------------------------------------------------
Option Explicit
Const swSelEDGES As Long = 1
Const swSelREFERENCECURVES As Long = 26
Const swSelPOINTREFS As Long = 41
Const swSelREFEDGES As Long = 51
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swPart As SldWorks.PartDoc
Dim swSelMgr As SldWorks.SelectionMgr
Dim nSelType As Long
Set swApp = CreateObject("SldWorks.Application")
Set swModel = swApp.ActiveDoc
Set swPart = swModel
Set swSelMgr = swModel.SelectionManager
nSelType = swSelMgr.GetSelectedObjectType3(1, -1)
Debug.Print "SelType (before) = " + Str(nSelType)
swModel.SelectMidpoint
nSelType = swSelMgr.GetSelectedObjectType3(1, -1)
Debug.Print "SelType (after ) = " + Str(nSelType)
End Sub