Firstly, You said VBA, but I did VB.net, my bad... you can hopefully translate the solution to work for you... its just groundwork anyway.
Now that that's covered... I generated some code that should run MUCH faster to acquire the desired curves. The sample below takes a portion of the filename and seeks that part out, it then gives access to the curves that make up each of the occurrences of that part...
I've dumbed it down to select the first curve in the group of curves, place a dumb leader on it and call it a day. It does that for each occurrence.
What you are looking to do may differ but hopefully this gets you headed in the right direction.
As is almost always the case, I AM NOT the sole progenitor of this code, I hacked and copied multiple awesome solutions from multiple talented programmers and augmented it to suit my purpose. The majority of the code came from Vladimir.Ananyev in solving another AutoColor issue, I make no attempt to call all these ideas herein my own. See link at end for original source question.
Sub Main
Dim SearchString As String
SearchString = "123456" 'Enter part or all of the document filename to seek
'step 1. select a drawingview
Dim oDrawDoc As DrawingDocument
oDrawDoc = ThisApplication.ActiveDocument
Dim oSheet As Sheet
oSheet = oDrawDoc.ActiveSheet
'for objects to be moved to specified layer
Dim oColl As ObjectCollection
oColl = ThisApplication.TransientObjects.CreateObjectCollection
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
' select drawing views on active sheet
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
Dim oDrawView As DrawingView
' Option 1: Have the user select a drawing view.
' Set oDrawView = ThisApplication.CommandManager _
'.Pick(kDrawingViewFilter, "Select a drawing view.")
' Option 2: we may process all drawing views on active sheet
For Each oDrawView In oSheet.DrawingViews
'adjust drawing view style
'oDrawView.ViewStyle = DrawingViewStyleEnum.kHiddenLineDrawingViewStyle
'step 2.
'Get the active drawing document.
Dim oDocDesc As DocumentDescriptor
oDocDesc = oDrawView.ReferencedDocumentDescriptor
' Verify that the selected drawing view is of an assembly.
If oDocDesc.ReferencedDocumentType <> kAssemblyDocumentObject Then
MessageBox.Show("The selected view must be of an assembly.")
Exit Sub
End If
Dim oAssyDoc As AssemblyDocument
oAssyDoc = oDocDesc.ReferencedDocument
'step 3
'filter required docs
Dim oRefDocs As DocumentsEnumerator
oRefDocs = oAssyDoc.AllReferencedDocuments
Dim oDoc As Inventor.Document
For Each oDoc In oRefDocs
'Criteria depends on your requirements:
'substring from filename, custom iProperty value, parameter value, etc.
If InStr(oDoc.FullFileName, SearchString) > 0 Then
'this is required document
'Debug.Print oDoc.FullFileName 'debug print only
'find all occurrences for every part found
Dim oOccEnum As ComponentOccurrencesEnumerator
oOccEnum = oAssyDoc.ComponentDefinition.Occurrences.AllReferencedOccurrences(oDoc)
For Each oOcc As ComponentOccurrence In oOccEnum
Dim oCurveEnum As DrawingCurvesEnumerator
oCurveEnum = oDrawView.DrawingCurves(oOcc)
Dim oCurve As DrawingCurve
oCurve = oCurveEnum.Item(1)
Dim oSegment As DrawingCurveSegment
Dim ctPoint As Point2D
Try
ctPoint = oCurve.MidPoint
Catch
ctPoint = oCurve.CenterPoint
End Try
Dim Pt1 As Point2D
Pt1 = ThisApplication.TransientGeometry.CreatePoint2d
Pt1.X = ctPoint.X + 2
Pt1.Y = ctPoint.Y + 3
Dim oObjCol As ObjectCollection
oObjCol = ThisApplication.TransientObjects.CreateObjectCollection
oObjCol.Add(Pt1)
oObjCol.Add(ctPoint)
oSheet.DrawingNotes.LeaderNotes.Add(oObjCol, "LeaderText")
Next 'oOcc
End If
Next 'oDoc
Next 'oDrawView
End Sub
Primary Source:
http://forums.autodesk.com/t5/inventor-customization/add-occurrences-to-the-selection-in-drawing-mod...
Best of Luck
---------------------------------------------------------------------------------------------------------------------------------
If you find this reply helpful or insightful, please use the 'Accept as Solution' or 'Kudos' button below.