Dim component As Object 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 selObj As Object Dim selEntity As Object Dim mate As Object Dim matename Dim selType Dim retval As Variant ' important coz this is an array Const swSelMATES = 21 Set swApp = CreateObject("SldWorks.Application") ' Attach to or open SolidWorks session Set Model = swApp.ActiveDoc ' Grab the current document ' Get the SelectionMgr interface Set SelMgr = Model.SelectionManager ' get the selection type selType = SelMgr.GetSelectedObjectType2(1) If selType = swSelMATES Then 'Text1.Text = "" 'traverse assembly Set feature = Model.FirstFeature While Not feature Is Nothing ' While we have a valid feature ft = feature.GetTypeName() ' we r looking for mategroup and so we can set MATE object 'The Mate object is actually a SubFeature beneath a "MateGroup" Feature. (from SW hlp file) If UCase(ft) = "MATEGROUP" Then Set subfeat = feature.GetFirstSubFeature 'traverse While Not subfeat Is Nothing ' While we have a valid Sub-feature Set mate = subfeat.GetSpecificFeature ' set MATE object matename = mate.Name ' not necessary but useful :) get mate name retval = mate.GetMateEntities() ' get mates array Set entity1 = retval(0) ' hlp says array starts from 0 so = first mate entity Set entity2 = retval(1) ' second retval = entity1.GetComponentName() ' we need to cut en extra "/" 'Text1.Text = Text1 + Mid$(retval, 2, Len(retval) - 1) retval = entity2.GetComponentName() ' ---|| --- 'Text1.Text = Text1 + "," + Mid$(retval, 2, Len(retval) - 1) + vbCrLf Set subfeat = subfeat.GetNextSubFeature ' go for next mate Wend ' Continue until the last Sub-feature is done End If Set feature = feature.GetNextFeature() ' till we find mategorup Wend Set entity1 = Nothing Set entity2 = Nothing Set mate = Nothing Set subfeat = Nothing Set feature = Nothing Set SelMgr = Nothing Set Model = Nothing Set swApp = Nothing Else Exit Sub ' no mate selected EXIT 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