'vba
Option Explicit
Sub CATMain()
Dim dDoc As DrawingDocument
Set dDoc = CATIA.ActiveDocument
Dim msg As String
msg = "Select the view from which to extract the coordinates of the hole / ESC = Cancel"
Dim selElement As SelectedElement
Set selElement = select_element( _
msg, _
Array("DrawingView") _
)
If selElement Is Nothing Then Exit Sub
Dim view As DrawingView
Set view = selElement.value
Dim cloneView As DrawingView
Set cloneView = get_clone_view(view)
'
Dim circles As Collection
Set circles = get_circles(cloneView)
If circles Is Nothing Then
remove_entity cloneView
Exit Sub
End If
Dim groupRadius As Object
Set groupRadius = group_by_radius(circles)
remove_entity cloneView
Call dump_circle_info( _
dDoc.sheets.ActiveSheet, _
"coordinate by " & view.name, _
groupRadius _
)
MsgBox "Done"
End Sub
Private Function dump_circle_info( _
ByVal sheet As DrawingSheet, _
ByVal viewName As String, _
ByVal dict As Object)
Dim numericKeys As Variant
numericKeys = quick_sort(get_numeric_keys(dict))
Dim coordinateView As DrawingView
Set coordinateView = create_view( _
sheet, _
viewName _
)
Dim a
Dim txt As DrawingText
Dim idx As Long
Dim coordinates As Collection
Dim coord As Collection
Dim infoLst As Collection
For idx = 0 To UBound(numericKeys)
Set infoLst = New Collection
infoLst.Add " ** diameter:" & numericKeys(idx) & " **"
infoLst.Add "- posX,posY -"
Set coordinates = dict.Item(Trim(Str(numericKeys(idx))))
For Each coord In coordinates
infoLst.Add Join(col2ary(coord), ",")
Next
Set txt = coordinateView.texts.Add( _
Join(col2ary(infoLst), vbCrLf), _
idx * 100, _
0 _
)
Next
End Function
Private Function get_numeric_keys( _
ByVal dict As Object) _
As Variant
Dim numericKeys() As Variant
ReDim numericKeys(dict.count - 1)
Dim ary As Variant
ary = dict.keys
Dim i As Long
For i = 0 To dict.count - 1
numericKeys(i) = CDbl(ary(i))
Next
get_numeric_keys = numericKeys
End Function
Private Function create_view( _
ByVal sheet As DrawingSheet, _
Optional ByVal name As String = vbNullString) _
As DrawingView
If name = vbNullString Then
name = "AutomaticNaming"
End If
Set create_view = sheet.views.Add(name)
End Function
Private Function group_by_radius( _
ByVal circles As Collection, _
Optional ByVal roundTolerance As Long = 3) _
As Object 'dict
Dim group As Object
Set group = init_dict()
Dim values As Collection
Dim center(1) As Variant
Dim dia As Double
Dim key As String
Dim c As Variant ' Circle2D
For Each c In circles
dia = Round(c.radius * 2, roundTolerance)
Call c.GetCenter(center)
key = Trim(Str(dia))
If group.Exists(key) Then
group.Item(key).Add ary2col(center)
Else
Set values = New Collection
values.Add ary2col(center)
group.Add key, values
End If
Next
Set group_by_radius = group
End Function
Private Function col2ary( _
ByVal col As Collection) _
As Variant
Dim ary() As Variant
ReDim ary(col.count - 1)
Dim i As Long
For i = 1 To col.count
ary(i - 1) = col.Item(i)
Next
col2ary = ary
End Function
Private Function ary2col( _
ByVal ary As Variant) _
As Collection
Dim col As Collection
Set col = New Collection
Dim i As Long
For i = 0 To UBound(ary)
col.Add ary(i)
Next
Set ary2col = col
End Function
Private Sub remove_entity( _
entity As AnyObject)
Dim sel As Selection
Set sel = CATIA.ActiveDocument.Selection
CATIA.HSOSynchronized = False
With sel
.Clear
.Add entity
.Delete
End With
CATIA.HSOSynchronized = True
End Sub
Private Function get_circles( _
ByVal view As DrawingView) _
As Collection
Set get_circles = Nothing
Dim sheet As DrawingSheet
Set sheet = get_parent_of_T(view, "DrawingSheet")
Dim sel As Selection
Set sel = CATIA.ActiveDocument.Selection
CATIA.HSOSynchronized = False
With sel
.Clear
.Add view
.Search "CATDrwSearch.2DCircle,sel"
End With
If sel.Count2 < 1 Then
CATIA.HSOSynchronized = True
Exit Function
End If
Dim circles As Collection
Set circles = New Collection
Dim i As Long
For i = 1 To sel.Count2
circles.Add sel.Item2(i).value
Next
sel.Clear
CATIA.HSOSynchronized = True
Set get_circles = circles
End Function
Private Function get_clone_view( _
ByVal view As DrawingView) _
As DrawingView
Dim sheet As DrawingSheet
Set sheet = get_parent_of_T(view, "DrawingSheet")
Dim sel As Selection
Set sel = CATIA.ActiveDocument.Selection
CATIA.HSOSynchronized = False
With sel
.Clear
.Add view
.Copy
.Clear
.Add sheet
.Paste
End With
Dim tempView As DrawingView
Set tempView = sel.Item2(1).value
sel.Clear
CATIA.HSOSynchronized = True
tempView.LockStatus = False
tempView.Isolate
Set get_clone_view = tempView
End Function
Private Function get_parent_of_T( _
ByVal aoj As AnyObject, _
ByVal t As String) _
As AnyObject
Dim aojName As String
Dim parentName As String
On Error Resume Next
aojName = aoj.name
parentName = aoj.Parent.name
On Error GoTo 0
If TypeName(aoj) = TypeName(aoj.Parent) And _
aojName = parentName Then
Set get_parent_of_T = Nothing
Exit Function
End If
If TypeName(aoj) = t Then
Set get_parent_of_T = aoj
Else
Set get_parent_of_T = get_parent_of_T(aoj.Parent, t)
End If
End Function
Private Function init_dict( _
Optional CompareMode As Long = vbBinaryCompare) _
As Object
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
dict.CompareMode = CompareMode
Set init_dict = dict
End Function
Private Function quick_sort( _
ByVal ary As Variant) As Variant
If IsEmpty(ary) Then
quick_sort = Empty
Exit Function
End If
Dim stack As Object
Set stack = init_dict()
Dim leftIdx As Long
Dim rightIdx As Long
Dim pivot As Variant
Dim tPivot(2) As Variant
Dim temp As Variant
Dim i As Long
Dim j As Long
stack.Add stack.count + 1, LBound(ary)
stack.Add stack.count + 1, UBound(ary)
Do While stack.count > 0
leftIdx = stack(stack.count - 1)
rightIdx = stack(stack.count)
stack.Remove stack.count
stack.Remove stack.count
If leftIdx < rightIdx Then
pivot = ary((leftIdx + rightIdx) / 2)
i = leftIdx
j = rightIdx
Do While i <= j
Do While ary(i) < pivot
i = i + 1
Loop
Do While ary(j) > pivot
j = j - 1
Loop
If i <= j Then
temp = ary(i)
ary(i) = ary(j)
ary(j) = temp
i = i + 1
j = j - 1
End If
Loop
If rightIdx - i >= 0 Then
If rightIdx - i <= 10 Then
insertion_sort ary, i, rightIdx
Else
stack.Add stack.count + 1, i
stack.Add stack.count + 1, rightIdx
End If
End If
If j - leftIdx >= 0 Then
If j * leftIdx <= 10 Then
insertion_sort ary, leftIdx, j
Else
stack.Add stack.count + 1, leftIdx
stack.Add stack.count + 1, j
End If
End If
End If
Loop
quick_sort = ary
End Function
Private Function insertion_sort( _
ary As Variant, _
minIdx As Long, _
maxIdx As Long)
Dim i As Long, j As Long
Dim temp As Variant
j = 1
For j = minIdx To maxIdx
i = j - 1
Do While i >= 0
If ary(i + 1) < ary(i) Then
temp = ary(i + 1)
ary(i + 1) = ary(i)
ary(i) = temp
Else
Exit Do
End If
i = i - 1
Loop
Next
insertion_sort = ary
End Function
Private Function select_element( _
ByVal msg As String, _
ByVal filter As Variant _
) As SelectedElement
Dim sel As Variant
Set sel = CATIA.ActiveDocument.Selection
sel.Clear
Select Case sel.SelectElement2(filter, msg, False)
Case "Cancel", "Undo", "Redo"
Exit Function
End Select
Set select_element = sel.Item(1)
sel.Clear
End Function
