CATIA V5です。こちらに挑戦しました。
Find the circle - DASSAULT: CATIA products - Eng-Tips
リンク付きDrawの丸い形状の中心座標を取得したいとの事ですが、
3Dのリンク付きのビューからは取得する事が出来ません。
これは手動で検索しても実感できます。
但し、リンクを分離すれば単なる線になる為、座標値の取得が可能です。
つまりビューをコピペし、分離し必要な情報を取得した後にコピペした
ビューを削除すれば良いのです。・・・Little Cthulhu氏、知っているくせに。
'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
ヘビーでした。
直径をキー、中心座標のコレクションを値としたDictを作っています。
最後は直径でソートして出力しているのですが、結果を出力させている
dump_circle_info関数の汚い事。
本来はテーブルで出力させようと思ったのですが、面倒になり力付きました。
CSVをインポートする機能がマクロで使えるのか分かりませんが、
使えるのであれば、CSV出力→インポートが楽だとは思いますが。