I don't know how well versed you are in programming, but I used an object oriented approach for this task (yes, it is possible in VBA)
I created a class for the curves, one for the holes, one for the dimensions, one for the geometry intent. That way, I could use a factory approach to when adding them to a collection class and integrate into the add method a check to see if there is already an equivalent element in my collection (e.g.: annotate a specific hole only once)
as an example: here the content of my class named cHoles which interact with my class cHole and other class. The Add method act as a factory and checks the type of hole it is (check the PartFeature to get the right diameter) and make sure to add it only once (dictionary .exists method shines here).
I give you this, because I know getting the feature from the part is difficult. the only way to find the feature if the curve selected was generated from a pattern feature, is to use the .[CreatedByFeatures] property which is not documented by Autodesk.
Option Explicit
Private HoleList As New Collection
Private HoleDictList As Object
Private RadiusDictList As Object
Public Property Get Hole(Key As Integer) As cHole
' Error Handling for non-existing curves
Err.Clear
On Error Resume Next
Set Hole = HoleList.item(Key)
If Err Then
Debug.Print "hole does Not exist"
End If
Err.Clear
End Property
Public Property Get count() As Integer
count = HoleList.count
End Property
Public Sub add(ByVal oCurve As DrawingCurve)
' Recieve a circle DrawingCurve, will look if created from a hole feature or not
' Redundancy are not filter yet at this stage
Dim oFace As Face
Dim oFeature As Object
Dim oHole As cHole
Dim oHoleFeature As HoleFeature
Dim Radius As Double
Dim HoleFeatBigDiameter As Double
Dim oSheet As Sheet
Dim intent As GeometryIntent
Dim Cmark As Centermark
Dim oView As DrawingView
'Create Centermark
Set oView = oCurve.Parent
Set oSheet = oView.Parent
Set intent = oSheet.CreateGeometryIntent(oCurve)
Set Cmark = oSheet.Centermarks.add(intent)
'If HoleDictList Is Nothing Then 'Initialize hole feature filter dictionary
' Set HoleDictList = CreateObject("Scripting.Dictionary")
'End If
'
'If RadiusDictList Is Nothing Then 'Initialize circle filter dictionary
' Set RadiusDictList = CreateObject("Scripting.Dictionary")
'End If
If oCurve.ProjectedCurveType = kCircleCurve2d Or oCurve.ProjectedCurveType = kCircularArcCurve2d Then 'Make surce oCurve is a circle or a circle arc
Set oHole = New cHole
Set oHole.Curve = oCurve
oHole.FeatureName = ""
If Not oView.IsFlatPatternView Then
For Each oFace In oCurve.ModelGeometry.Faces 'Loop through corresponding faces connected to the hole curve
'Prevent working with FaceProxies (meaning hole is not created in this document, Happens in assemblies)
If Not TypeOf oFace Is FaceProxy And TypeOf oFace Is Face Then
If oFace.SurfaceType = kCylinderSurface Or oFace.SurfaceType = kConeSurface Then
' Loop through features participating in creation of the hole, this way, we can find the parent feature
' of a repetition feature or a mirror feature
For Each oFeature In oFace.[_CreatedByFeatures]
If TypeOf oFeature Is HoleFeature Then
Set oHoleFeature = oFeature
oHole.FeatureName = oHoleFeature.name
'Add place dimension on cbore or csink diameter, not inner diameter
Select Case oHoleFeature.HoleType
Case kCounterBoreHole
HoleFeatBigDiameter = oHoleFeature.CBoreDiameter.Value 'Value is in centimeter
Case kCounterSinkHole
HoleFeatBigDiameter = oHoleFeature.CSinkDiameter.Value 'Value is in centimeter
Case Else
HoleFeatBigDiameter = 0
End Select
' Make sure curve is outer diameter and feature not already in use
If Round(oCurve.ModelGeometry.Geometry.Radius * 2, 4) >= Round(HoleFeatBigDiameter, 4) Then
If Not HoleDictList.exists(oHoleFeature.name) Then
HoleDictList.add oHoleFeature.name, True ' Add to dictionary for future filtering
HoleList.add oHole
Exit For
End If
End If
End If
Next oFeature
End If
End If
Next oFace
End If
' If no hole feature was found, then consider as regular circle (will be general dimension instead of holenote)
If oHole.FeatureName = "" Then
Radius = Round(oCurve.Segments.item(1).Geometry.Radius, 4)
If Not RadiusDictList.exists(Radius) Then
RadiusDictList.add Radius, True 'Add to dictionnary for future filtering
oHole.Radius = Radius
oHole.OccurrenceNumber = 1
HoleList.add oHole
Else 'Find the hole with same radius and change occurrence value +1
AddOccurrence Radius
End If
End If
End If
End Sub
Private Sub AddOccurrence(ByVal Radius As Double)
' Add + 1 to ohole occurrence
Dim oHole As cHole
For Each oHole In HoleList
If oHole.Radius = Radius Then
oHole.OccurrenceNumber = oHole.OccurrenceNumber + 1
Exit For
End If
Next oHole
End Sub
Private Sub Class_Initialize()
' Event lauched at the first initialization of the class
Set RadiusDictList = CreateObject("Scripting.Dictionary")
Set HoleDictList = CreateObject("Scripting.Dictionary")
End Sub
happy coding
