Announcements
Attention for Customers without Multi-Factor Authentication or Single Sign-On - OTP Verification rolls out April 2025. Read all about it here.
Owner2229
in reply to: Stryder33345

Hi, try this and let me know if it does what you want.

It will ask you to select part(s). Select as mayn as you want and end the selection with "Esc".

 

Sub Main()
   Dim oDoc As Document
   oDoc = ThisApplication.ActiveDocument
   Dim comps As ObjectCollection
   Dim comp As ComponentOccurrence
   oDoc.SelectSet.Clear
   comps = ThisApplication.TransientObjects.CreateObjectCollection
   While True
      comp = ThisApplication.CommandManager.Pick(
      SelectionFilterEnum.kAssemblyLeafOccurrenceFilter,
      "Select Part(s)")
      'If nothing gets selected then we're done	
      If IsNothing(comp) Then Exit While
      comps.Add(comp) 
   End While
   'If there are selected components we can do something, otherwise we're done
   If comps.count = 0 Then Exit Sub
   Dim aDoc As DocumentsEnumerator
   aDoc = oDoc.AllReferencedDocuments
   Dim iDoc As Document
   Dim cName As String
   Dim cTS As String
   Dim sTS As String
   Dim FNP As Long
   Dim cFNP As Long
   Dim docFN As String
   For Each iDoc In aDoc
      sTS = iDoc.FullFileName
      FNP = InStrRev(sTS, "\", - 1)
      docFN = Mid(sTS, FNP + 1, Len(sTS) - FNP)
      For Each comp In comps
         cTS = comp.Name
         cFNP = InStrRev(cTS, ":", - 1)
	 cName = Left(cTS, cFNP - 1)
	 If cName = Left(docFN, Len(docFN)-4) Then
	    'Set iProperty in each of the selected parts in assembly
            iProperties.Value(docFN, "Custom", "Mark") = "this part is now marked"
	 End If
      Next
   Next
   oDoc.SelectSet.Clear
End Sub
Consider using "Accept as Solution" / "Kudos" if you find this helpful.
- - - - - - - - - - - - - - -
Regards,
Mike

"Always code as if the guy who ends up maintaining your code will be a violent psychopath who knows where you live." - John F. Woods