Dim swApp As Object ' Define variable used to hold the SldWorks object
Dim Model, Part As Object ' Define variable used to hold the ModelDoc & PartDoc objects
Dim SelMgr As Object ' Define variable used to hold the SelectionManager object
Dim comp As Object
Dim selEntity As Object
Dim sketch
Dim sketchPointArray As Variant
Dim theSketch As Object ' Optional (see below)
Dim pointCount As Integer
Dim xValue As Double
Dim yValue As Double
Dim zValue As Double
Dim mysel_ptx As Double
Dim mypt As Variant
Dim mystr As String

Set swApp = CreateObject("SldWorks.Application") ' Attach to or open SolidWorks session
Set Model = swApp.ActiveDoc ' Grab the current document
Set Part = Model  ' PartDoc & ModelDoc are same in VB

Set SelMgr = Model.SelectionManager() ' Get the selection manager class

If (SelMgr.GetSelectedObjectCount <> 0) Then ' If user has selected something
 
        'Set selObj = SelMgr.GetSelectedObject2(1) ' Get the first item in the selection list
        selections = ""
        Set selEntity = SelMgr.GetSelectedObject3(1)
        Set sketch = selEntity.Getsketch()
        mystr = sketch.Name
 'ENT = Model.GetEntityName(sketch) 'return the same as sketch.name
  
selections = selections + mystr + "@"

 Set comp = SelMgr.GetSelectedObjectsComponent(1)
 mystr = comp.Name2
 selections = selections + mystr + "@"
 
 mystr = Model.GetTitle
 mystr = Mid$(mystr, 1, Len(mystr) - 7)
 selections = selections + mystr + ")"
mypt = SelMgr.GetSelectionPoint(1)

If (Not (IsEmpty(mypt))) Then
        mysel_ptx = mypt(0)
        mysel_pty = mypt(1)
        mysel_ptz = mypt(2)
End If

Set theSketch = sketch
sketchPointArray = theSketch.GetSketchPoints
pointCount = UBound(sketchPointArray) + 1
For i = 0 To (pointCount - 1) ' For each SketchPoint
        xValue = sketchPointArray(i).X ' Get the coordinates
        yValue = sketchPointArray(i).y
        zValue = sketchPointArray(i).Z
        If xValue = mysel_ptx And yValue = mysel_pty And zValue = mysel_ptz Then
                mystr = "Point" + Trim(Str(i + 1))
                selections = mystr + "@" + selections
                Exit For
        End If
Next i
Text1.Text = "Selections:(" + selections
Set swApp = Nothing
Set Model = Nothing
Set Part = Nothing
Set SelMgr = Nothing
Set selEntity = Nothing
Set sketch = Nothing
Set comp = Nothing
Set theSketch = Nothing

End If


http://programming.e-cnc.com

Mike Dejanovic
8512 Nichols Rd.
Windham, OH, 44288-9518
USA

Comments are welcome:
e-mail: e-cnc@e-cnc.com
9ahsd@iname.com