久々にCATIAです。
Drawのシート内に空のテキストを全て削除するマクロです。
'vba 'Drawの空のテキストを削除 Option Explicit Sub CATMain() 'ドキュメント Dim doc As DrawingDocument Set doc = CATIA.ActiveDocument '空のテキスト取得 Dim nullTxts As Collection Set nullTxts = getNullTxts(doc.sheets.ActiveSheet) If nullTxts.Count < 1 Then MsgBox "アクティブなシートには空のテキストは見つかりませんでした" Exit Sub End If '問い合わせ Dim msg As String msg = Str(nullTxts.Count) + _ "個の空のテキストが有ります" + _ vbCrLf + "全て削除しますか?" If MsgBox(msg, vbQuestion + vbYesNo) = vbNo Then Exit Sub End If '削除 Call removeItem(nullTxts) 'おしまい MsgBox "Done" End Sub Private Sub removeItem( _ ByVal items As Collection) Dim sel As Selection Set sel = CATIA.ActiveDocument.Selection CATIA.HSOSynchronized = False sel.Clear Dim ent As AnyObject For Each ent In items sel.Add ent Next sel.Delete CATIA.HSOSynchronized = True End Sub Private Function getNullTxts( _ ByVal sheet As DrawingSheet) As Collection Dim nullTxts As Collection Set nullTxts = New Collection Dim view As DrawingView Dim txt As DrawingText For Each view In sheet.views If view.Texts.Count < 1 Then '理由分からなんが空はエラーになる… GoTo continue End If For Each txt In view.Texts If txt.Text = vbNullString Then nullTxts.Add txt End If Next continue: Next Set getNullTxts = nullTxts End Function
アクティブなシート内の全てのビューにあるテキストを、グルッと
一周し空のテキストをかき集めて、まとめて削除してます。
For Each txt In view.Texts
ここでビュー内の全てのテキストを回っているのですが、
Texts.countが0だと(要は一個も無い)エラーになるんだ・・・。
For Eachに空のコレクション渡すとスルーするのかと
思っていたのに。