読者です 読者をやめる 読者になる 読者になる

C#ATIA

↑タイトル詐欺 主にCATIA V5 の VBA

ダイアログオフが思った程、機能していない

上手く行かない と思っていたらこんな記述を発見。

PowerMILL 2017 Dialogs On\Off error when run macro. - Autodesk Community

要はこんな感じでコードを書いておくと、ダイアログが表示されなくなります。
・・・されなくなる、はずでした。

  DIALOGS MESSAGE OFF


困っていたのは、マクロの処理中にダイアログが出てきちゃって、マクロ自体が止まっちゃうの
です。こっちとしては処理中に他の作業を行いたいので、まとめてマクロで処理させたい
のに離れられなくなっちゃうんです。
10年ぐらいの前のバージョンのPowerMill7でも、機能していたのに・・・。

と、イロイロ探しながら悩んでいたら、マクロの記録をとったらしっかりと記載されて
いましたw


あまりに汚いコードなので、一部のみの公開です。
ダイアログが出て困っていたのは、ツールパスをアペンド(連結)させた際に出てくる
確認用のダイアログです。上手く以下なかった際の処理はこんな感じ。

コード的には

	DIALOGS MESSAGE OFF
	foreach Itm in $AppendLst {
		//アペンド処理
		EDIT TOOLPATH $CopyedName APPEND CONFIRM $Itm
	}
	DIALOGS MESSAGE ON

記録をとった上、修正したコードがこちら。

	foreach Itm in $AppendLst {
		EDIT TOOLPATH $CopyedName APPEND CONFIRM $Itm
		Yes //悩んだ末の解決策がこれだけ
	}

実際に上手く処理できるようになった動画はこちらです。

さっさと記録とれば良かった・・・。

計算済みコーナーペンシル仕上げを逆方向にする

PowerMillの機能の中でちょっとだけ不満なのが、コーナーペンシル仕上げ加工。

大体の3DCAMソフトには付いている機能なのですが、今まで経験した中で
唯一PowerMillだけ、下から上にツールパスを作成してくれません。
(使いたい理由は秘密)

サポートさんには機能をつけて欲しいと要望を出しましたが、所詮小市民の
戯言なので、期待は出来ないと思ってます。

上から下へのツールパスを手動で方向逆転させられるので、作れなくはないの
ですが、この操作がメニューの深いところにあるため非常に面倒です。

その為、マクロを作成しまとめて処理させる事にしました。

//pm2017 macro sample_All_Pencil_corner_Rev.mac
//全ての計算済みコーナーペンシル仕上げ加工の方向を逆にする

function Main() {
	//ペンシル検索
	STRING LIST PathLst = {}
	call GetPencilLIST($PathLst)
	
	//チェック
	STRING msg = ''
	if is_empty($PathLst) {
		$msg = '処理可能なペンシルパスがありません!!'
		message error $msg
		return
	}
	
	//メッセージ
	BOOL yesno = 0
	call ListToString(PathLst, $msg)
	$msg = '以下のペンシルパスを逆方向にします。宜しいですか?' + crlf + $msg
	$yesno = QUERY $msg
	IF not yesno {
		return
	}
	
	//リバース
	STRING ActPathName = TOOLPATH.NAME
	call SetReverse(PathLst)
	
	//アクティブツールパスを実行前に戻す
	call ReActToolPath($PathLst, $ActPathName)
}

//実行前アクティブツールパスに戻す
function ReActToolPath(STRING LIST lst, STRING PathName) {
	STRING ReActName = ''
	if member($lst, $PathName) {
		call GetAfterPathName($PathName, $ReActName)
	} else {
		$ReActName = $PathName
	}
	ACTIVATE TOOLPATH $ReActName
}

//変換後のツールパス名取得
function GetAfterPathName(STRING PathName, output STRING NewName) {
	STRING Key = '_Rev'
	STRING Before = $PathName
	INT RevPos = position($Before, $Key)
	STRING After = ''
	if $RevPos == -1 {
		$After = $Before + $Key
	} else {
		$After = replace($Before, $Key, '')		
	}
	$NewName = $After
}

//パス名修正
function RenamePath(STRING PathName) {
	STRING After = ''
	call GetAfterPathName($PathName, $After)
	RENAME Toolpath $PathName $After
}

//逆方向
function SetReverse(STRING LIST lst) {
	foreach itm in lst {
		ACTIVATE TOOLPATH $itm
		EDIT TOOLPATH REVERSE
		call RenamePath(itm)
	}
}

//計算済みペンシル
function GetPencilLIST(output STRING LIST Out_lst) {
	STRING LIST lst = {}
	foreach itm in folder('Toolpath') {
		if itm.computed {
			if itm.Strategy == 'pencil_corner' {
				INT dmy = add_last(lst, itm.name)
			}
		}
	}
	INT dmy = remove_duplicates(lst)
	$Out_lst = lst
	return
}

//リストの文字化
function ListToString(STRING LIST lst, output STRING Out_msg) {
	STRING msg = ""
	foreach itm in lst {
		$msg = msg + itm + crlf
	}
	$Out_msg = msg
}

ツリーのツールパスフォルダ内の計算済みコーナーペンシル仕上げ加工を全て探し出し、
逆転させます。その際、ツールパスの名称を逆転させたものには、
"ツールパス名" + "_Rev" の名称に変更し、再度実行した際は "_Rev"
の名称を削除します。
(手動でゴチョゴチョした際は、もちろんそうなりません・・・)

実際に使用した感じです。 最初に通常に作成したシミュレーションを
実行し、マクロ実行後のシミュレーションを実行してみました。


"Macro Programming Guide" に計算済みツールパスを判断するためのサンプル
が記載されているのですが、パラメータ部分が

IF entity(‘toolpath’,Name) .Calculated {

となっているのですが、正しくは

IF entity(‘toolpath’,Name).computed {

です。 参考に出来るものが少ないだけに誤記は勘弁して欲しい。
(他にも幾つかあります)

PowerMillに同位置の作業平面を作る

加工する際、世の中の方々は加工原点をどうやって決めているんでしょうか?
部品の原点が決まっているようであれば、そこを原点にするのかも知れない
のですが、基準まで加工して作る場合は・・・バイスを使用していたら材料の
上側の左奥(か、右奥・・・わかりにくいですね)になるのだろうと思いますが、
社内で使用している治具の関係で、うちの場合は材料底面の中心部分にする
と言う、暗黙なルールが見え隠れしています。

こんな感じです。
f:id:kandennti:20170210190831p:plain

悩むのが、CADの原点と加工原点が違う際にどうするのか?
世間の皆様はどうしているのでしょう???
恐らくCAM側で加工原点を作成して作業をするのだろうと思うのですが、
個人的にPowerMillの作業平面(加工原点)の操作が、思ったより
やりにくい・・・(うちが材料の中心部にしているせいです)

なので、今まではCATIAで座標変換させてIgesエクスポートさせていたのですが、
後々に確認したい場合に結構不便で困っていました。



PowerMillのマクロは独自言語なのですが、外部からマクロの実行が出来ます。
VBAでも出来ちゃうので、CATIAの座標系情報を元にPowerMillの作業平面を
作成してしまおう! と思いつき、マクロを作ってみました。

'vba sample_PM_Push_AxisSystem Ver0.0.1
'using-'KCL0.0.10' 'PowerMill'
Option Explicit

Sub CATMain()
    'ドキュメントのチェック
    If Not CanExecute("PartDocument") Then Exit Sub
    
    'パワーミル取得
    Dim Pm As Object: Set Pm = GetPowerMill()
    If KCL.IsNothing(Pm) Then
        MsgBox "パワーミルを起動して下さい!"
        Exit Sub
    End If
    
    'エクスポートする座標系選択
    Dim Axis As AxisSystem
    Set Axis = KCL.SelectItem("座標系を選択して下さい", "AxisSystem")
    If KCL.IsNothing(Axis) Then Exit Sub

    '座標系データ取得
    Dim AxisCoord As Variant: AxisCoord = GetAxisCoord(Axis)
    
    'パワーミル 作業平面作成
    Call CreateWorkPlane_Pm(Pm, AxisCoord)
End Sub


' *** Catia ***
'座標系データ取得
Private Function GetAxisCoord(ByVal Axis As AxisSystem) As Variant
    Dim Ax: Set Ax = Axis
    Dim Ori(2), VecX(2), VecY(2)
    Call Ax.GetOrigin(Ori)
    Call Ax.GetVectors(VecX, VecY)
    
    GetAxisCoord = Array(Axis.Name, _
                         Ori(0), Ori(1), Ori(2), _
                         VecX(0), VecX(1), VecX(2), _
                         VecY(0), VecY(1), VecY(2))
End Function


'*** PowerMill ***
'パワーミル取得
Private Function GetPowerMill() As Object
    On Error Resume Next
        Set GetPowerMill = GetObject(, "PMILL.Document")
    On Error GoTo 0
End Function

'ダイアログ類オン
Private Sub DialogOn_Pm(ByVal Pm As Object)
    With Pm
        Call .Docommand("DIALOGS MESSAGE ON")
        Call .Docommand("DIALOGS ERROR ON")
        Call .Docommand("ECHO ON DCPDEBUG TRACE COMMAND ACCEPT")
    End With
End Sub

'ダイアログ類オフ
Private Sub DialogOff_Pm(ByVal Pm As Object)
    With Pm
        Call .Docommand("DIALOGS MESSAGE OFF")
        Call .Docommand("DIALOGS ERROR OFF")
        Call .Docommand("ECHO OFF DCPDEBUG UNTRACE COMMAND ACCEPT")
    End With
End Sub

'パワーミルに作業平面作成
Private Sub CreateWorkPlane_Pm(ByVal Pm As Object, ByVal Axcoord As Variant)
    Call DialogOff_Pm(Pm)
    
    With Pm
        '新エンティティ名
        Call .Execute("string NewName = new_entity_name('Workplane')", 1)
        
        '作業平面作成・編集開始
        Call .Execute("CREATE WORKPLANE ; EDITOR", 1)
        Call .Execute("ACTIVATE WORKPLANE $NewName", 1)
        Call .Execute("MODE WORKPLANE_EDIT START $NewName", 1)
        
        'リネーム
        Dim ReName$: ReName$ = Get_NewWPName_Pm(Pm, Axcoord(0))
        If Not ReName$ = vbNullString Then
            Call .Execute("MODE WORKPLANE_EDIT NAME """ & ReName & """ ", 1)
        End If
    
        '原点
        Call .Execute("MODE WORKPLANE_EDIT POSITION", 1)
        Call .Execute("MODE POSITION WORKSPACE WORLD", 1)
        Call .Execute("MODE POSITION PLANE XY", 1)
        Call .Execute("MODE POSITION CARTESIAN X """ & CStr(Axcoord(1)) & """ ", 1)
        Call .Execute("MODE POSITION CARTESIAN Y """ & CStr(Axcoord(2)) & """ ", 1)
        Call .Execute("MODE POSITION CARTESIAN Z """ & CStr(Axcoord(3)) & """ ", 1)
        Call .Execute("POSITION APPLY", 1)
        
        'X軸
        Call .Execute("MODE WORKPLANE_EDIT DIRECTION X", 1)
        Call .Execute("MODE DIRECTION WORKSPACE WORLD", 1)
        Call .Execute("MODE DIRECTION COMPONENT I """ & CStr(Axcoord(4)) & """ ", 1)
        Call .Execute("MODE DIRECTION COMPONENT J """ & CStr(Axcoord(5)) & """ ", 1)
        Call .Execute("MODE DIRECTION COMPONENT K """ & CStr(Axcoord(6)) & """ ", 1)
        Call .Execute("DIRECTION ACCEPT", 1)
        
        'Y軸
        Call .Execute("MODE WORKPLANE_EDIT DIRECTION Y", 1)
        Call .Execute("MODE DIRECTION WORKSPACE WORLD", 1)
        Call .Execute("MODE DIRECTION COMPONENT I """ & CStr(Axcoord(7)) & """ ", 1)
        Call .Execute("MODE DIRECTION COMPONENT J """ & CStr(Axcoord(8)) & """ ", 1)
        Call .Execute("MODE DIRECTION COMPONENT K """ & CStr(Axcoord(9)) & """ ", 1)
        Call .Execute("DIRECTION ACCEPT", 1)
        
        '編集終了
        Call .Execute("MODE WORKPLANE_EDIT FINISH ACCEPT", 1)
    End With
    
    Call DialogOn_Pm(Pm)
End Sub

'重複を避けた作業平面名を取得
Private Function Get_NewWPName_Pm(ByVal Pm As Object, ByVal Name As String) As String
    Get_NewWPName_Pm = Name
    
    If Name = vbNullString Then Exit Function
    
    Dim Ret, CallBackMsg$
    With Pm
        Call .Docommand("STRING LIST $lst={}")
        Ret = .Execute("$lst = extract(folder('Workplane'), 'name')", 1)
        Ret = .ExecuteEx("PRINT PAR '$lst'", 0, CallBackMsg)
    End With
    
    Dim WPNameDic As Object: Set WPNameDic = Get_WPNameList_Pm(CallBackMsg)
    If WPNameDic.Count < 1 Then Exit Function
    
    Dim TmpName$: TmpName = Name
    Dim Count&: Count = 0
    Do
        If Not WPNameDic.Exists(TmpName) Then Exit Do
        Count = Count + 1
        TmpName = Name & "_" & CStr(Count)
    Loop
    
    Get_NewWPName_Pm = TmpName
End Function

'パワーミルの作業平面名辞書
Private Function Get_WPNameList_Pm(ByVal Txt As String) As Object
    Set Get_WPNameList_Pm = Nothing
    Const Key = "(STRING) "
    Dim KeyLng: KeyLng = Len(Key)
    
    Dim Ary: Ary = Split(Txt, vbNewLine)
    Dim Dic As Object: Set Dic = KCL.InitDic()
    
    Dim i&, KeyIdx&
    For i = 0 To UBound(Ary)
        KeyIdx = InStr(Ary(i), Key)
        If KeyIdx > 0 Then
            Call Dic.Add(Mid(Ary(i), KeyIdx + KeyLng), 1)
        End If
    Next
    
    Set Get_WPNameList_Pm = Dic
End Function

CreateWorkPlane_Pm関数が、ビックリするぐらい酷い状況・・・。
結果的に、GetObjectでPowerMillを所得しマクロのコードを垂れ流しです。



実際に試してみた動画がこちら
(予め、CADデータはインポートしてあります)

作業平面を作る過程を止める事も出来るようですが、動画に箔がつくのでそのままです。
本当は、作成した作業平面をアクティブにしたかったのですが・・・上手く行ってません。
それでも便利です。 悩みが一個解消しました。


忘れちゃいそうなので、覚書としてのコード的な部分です。

外部からの操作で、関数の戻り値が取得できるものかどうか疑問でしたが、
フォーラムの記載を参考にしました。 作業平面名の重複を避けるため作業平面フォルダ
から全作業平面名を取得する必要が有りました。
Get_NewWPName_Pm・Get_WPNameList_Pm関数でその辺の処理をしています。

こちらのコードはエコーコマンドの表示を止めるもののようで、
中にはこの表示を止めないとマクロが上手く動作しないものがあるようです。
(よくわかっていないのですが、エラーがらみだと思います)

ECHO OFF DCPDEBUG UNTRACE COMMAND ACCEPT

ところが逆のエコーコマンドに表示させる為のコードが、探しても探しても
見つかりませんでした。 何となく感で打ち込んだところ
こちらで再表示させられるようになりました。

ECHO ON DCPDEBUG TRACE COMMAND ACCEPT

ひょっとしたら何処かに記載されているかも。

フォルダ名リストを取得する

想像以上に苦しく、進まない PowerMillマクロです。
でも、メンドクサイ類似作業の繰り返しはコリゴリなので、進めてます。

以前はメモ帳で作っていたのですがw AutodeskのForumでこんな記述を発見。
Notepad++ Language for editing PowerMill macros. - Autodesk Community

Notepad++と言うエディタの、PowerMillマクロ言語用のものがあるなんてありがたいです。
確かにマニュアルにもチラチラ出てくる名前のエディタなので、使おうと思ったのですが
日本語が未対応っぽい。

探すとこちらがHitしました。
Notepad++ ja-pack 1 (日本語パック) を公開してみた。 | OFF-SOFT.net

ん~よく読んでないせいか、画面が日本語になっていない・・・。 "Shift-JIS" は
使えているので、まぁこのままで行きます。



で、本題の方ですが、僕の場合Treeが長くなるのがイヤなので、
ツールパスや工具フォルダ内にフォルダを作って作業してます。 こんな感じです。
f:id:kandennti:20170209191356p:plain

面倒なんですが、ダッダーっと長いのはイヤなんです。 何れはマクロやテンプレートで
作るし。

後々に利用する事になりそうなので、組み込みフォルダ内のフォルダ名リストを取得する
マクロです。

//pm2017 macro
//フォルダ名取得 クズテスト

function Main() {
	STRING LIST lst = {}
	//ツールパス
	call GetFolderNameLIST('Toolpath', $lst)
	call Dump(lst)
	
	//工具
	call GetFolderNameLIST('Tool', $lst)
	call Dump(lst)
}

//指定した組み込みルートフォルダ内のフォルダ名を取得
function GetFolderNameLIST(STRING Lst_name, output STRING LIST Folder_lst ) {
	STRING LIST lst = {}
	foreach itm in folder(Lst_name) {
		INT dmy = add_last(lst, basename(dirname(pathname(itm))))
	}
	INT dmy = remove_duplicates(lst)
	$Folder_lst = lst
	return
}

function Dump(STRING LIST lst) {
	STRING msg = ""
	foreach itm in lst {
		$msg = msg + itm + crlf
	}
	print = msg
}


エコーコマンドで出力させてます。 結果はこんな感じ。

 ・・・

Process Command : [\tprint = msg\n]

r2s_base
r1s_base
r05s_base

 ・・・

Process Command : [\tprint = msg\n]

path
ref

 ・・・

ん~ 理由はわかっているのですが、空のフォルダ名が取得できていないです。
ネストしているフォルダ名も実は取れないんですけど、それは禁止にしよう・・・。

PowerMill 言語環境の切り替え

Space-eをバージョンアップしたのですが、ありがたい事にPowerMillも
バージョンアップしてR2017が使えるようになりました。
(Fusion360CAMの利用を考えなくなったのはその為です)

個人的にはPowerMillは非常に優秀だと思っているのですが、
こちらの件だけは、ちょっと頂けないです。
PowerMILLのVortex - C#ATIA


出来上がる経路の優秀さはもちろんなのですが、マクロがかなり強力で
手動の操作の大半が出来るのではないのかな? と思っています。

マクロの言語は独自ですが、CATIA同様に記録が録れるのでスタートするには
十分な程の環境です。
(マクロだけでなく、プラグイン作成用のサンプルがVBC#等でも用意されています)

DELCAM時代からメーカーさんも、積極的に情報やツールを公開し、メーカーさんの
フォーラムでも積極的なアドバイスをしていた為、非常に良い印象を持って
おります。(Autodeskさんになってからも、フォーラムは好印象です)


こちらでも楽をしたいので、マクロを作成したいのですが日本語環境の
ままではやりにくい部分も有り、何とか英語環境で起動したいところ。

Helpに記載が見当たらなかったので、調べてみるとこちらが
Hitしました。(ロシア語起動)
Solved: How to change language in Powermill - Autodesk Community


理解力が乏しい為か、これはちょっと違っておりこんな感じでした。

PowerMill > lang

Enter language to use > english

大文字小文字は無関係で、一度 "lang" でEnter、"english" でEnterです。
他の言語の場合は、インストールフォルダ内に言語別のフォルダがあったので
恐らくそのフォルダ名でOKのような気がしています。(未確認です)

日本語に戻す場合は

PowerMill > lang

Enter language to use > japanese

です。

・・・これもメンドクサイのでマクロにしました。
英語へ

//pm2017 ChangeLang_Eng.mac
//英語環境へ切り替え

LANG
English

日本語へ

//pm2017 ChangeLang_JPN.mac
//日本語環境へ切り替え

LANG
Japanese

これだけなんですけどね。

CATIAと異なり、切り替えてもPowerMillの再起動は必要有りませんでした。

Drawのテキストサイズを変更する

"Drawのテキストサイズを変更したけど反映されない?" のような
ご相談を頂きましたが、ちょっと状況がわからないので、
現象を再現できないでいます。

クリックしたテキストのサイズを2倍にするだけのテストコードです。

'vba test_DrawTextSize_Double
'using-'KCL0.0.10'
'DrawTextサイズを2倍にする

Sub CATMain()
    'ドキュメントのチェック
    If Not KCL.CanExecute("DrawingDocument") Then Exit Sub
    
    Dim Msg$: Msg = "テキストを選択して下さい : ESCキー 終了"
    Dim Dt As DrawingText
    Dim DtSize#
    
    Do
        Set Dt = KCL.SelectItem(Msg, "DrawingText")
        If KCL.IsNothing(Dt) Then Exit Do
        DtSize = Dt.GetFontSize(0, 0) 'サイズ取得
        Dt.SetFontSize 0, 0, DtSize * 2 'サイズ設定
    Loop
End Sub

イロイロあり、今までR2012を使用していたのでKCLがVBA7に未対応な
状態でしたので、修正しました。
他にも修正したい部分はあるのですが、時間が無く・・・・。

2Dコンポーネントを展開する

こちらの続きです。
指定した2D要素を、指定した原点位置でコピペする - C#ATIA


予告していた、2Dコンポーネント(2D構成要素)を展開するマクロです。

アクティブなDrawシート全てのビュー内(メイン・背景・ロック・非表示)にある
2Dコンポーネントが対象です。

'vba sample_Comp2DExplode ver0.0.3
'using-'KCL0.09'
'アゥティブなシートのメインと背景以外のビューにある2Dコンポーネントを全て展開

Option Explicit

Sub CATMain()
    'ドキュメントのチェック
    If Not KCL.CanExecute("DrawingDocument") Then Exit Sub

    'コンポーネント2Dの存在するビュー取得
    Dim ViewLst As Collection: Set ViewLst = GetExistComp2DView()
    If ViewLst.Count < 1 Then
        MsgBox "アクティブなシート内のアンロックされたビュー内には、" & vbNewLine & _
               "コンポーネント2Dが存在しませんでした", vbInformation
        Exit Sub
    End If
    
    'コンポーネント2D取得
    Dim CompLst As Collection: Set CompLst = GetComp2DList(ViewLst)
    
    'ユーザー選択
    Dim Msg$: Msg = "アクティブなシートには" & _
                    CreateMsg(ViewLst, CompLst) & vbNewLine & _
                    "のコンポーネント2Dが存在します。 全て展開しますか?"
    If MsgBox(Msg, vbOKCancel + vbInformation) = vbCancel Then Exit Sub
    
    '展開
    Call ExecuteExplode(CompLst)
    
    '終了
    MsgBox "終了"
End Sub

'展開
Private Sub ExecuteExplode(ByVal CompLst As Collection)
    Dim Lst As Collection
    Dim Cmp As DrawingComponent
    Dim Sel As Selection: Set Sel = CATIA.ActiveDocument.Selection
    
    CATIA.HSOSynchronized = False
        Sel.Clear
        For Each Lst In CompLst
            For Each Cmp In Lst
                Cmp.Explode
                Sel.Add Cmp
            Next
        Next
        Sel.Delete
    CATIA.HSOSynchronized = True
End Sub

'メッセージ作成
Private Function CreateMsg(ByVal ViewLst As Collection, _
                            ByVal CompLst As Collection) As String
    Dim Ary(): ReDim Ary(ViewLst.Count)
    Dim i&
    For i = 1 To ViewLst.Count
        Ary(i) = "ビュー '" & ViewLst(i).Name & "' - " & _
                    CStr(CompLst(i).Count) & "個"
    Next
    CreateMsg = Join(Ary, vbNewLine)
End Function

'コンポーネント2D取得
Private Function GetComp2DList(ByVal ViewLst As Collection) As Collection
    Set GetComp2DList = Nothing
    
    Dim Vw As DrawingView
    Dim Lst As Collection: Set Lst = New Collection
    For Each Vw In ViewLst
        Lst.Add DeepCopyCatCollection(Vw.Components, "DrawingComponents")
    Next
    Set GetComp2DList = Lst
End Function

'コンポーネント2Dの存在するビュー取得  メイン・背景・ロック・非表示除外
Private Function GetExistComp2DView() As Collection
    Set GetExistComp2DView = Nothing
    
    Dim Vws As DrawingViews
    Set Vws = CATIA.ActiveDocument.Sheets.ActiveSheet.Views
    If Vws.Count < 3 Then Exit Function
    
    Dim ViewLst As Collection
    Set ViewLst = DeepCopyCatCollection(Vws, "DrawingViews")
    Call ViewLst.Remove(1) 'メイン削除
    Call ViewLst.Remove(1) '背景削除
    
    
    Dim Vw As DrawingView
    Dim Lst As Collection: Set Lst = New Collection
    For Each Vw In ViewLst
        If Vw.LockStatus = False And IsShow(Vw) And _
                                Vw.Components.Count > 0 Then
            Lst.Add Vw
        End If
    Next
    Set GetExistComp2DView = Lst
End Function

'表示?
Private Function IsShow(ByVal Oj As AnyObject) As Boolean
    Dim Sel As Selection: Set Sel = CATIA.ActiveDocument.Selection
    Dim Vis As VisPropertySet:
    Set Vis = Sel.VisProperties
    Dim ShowState As CatVisPropertyShow
    
    CATIA.HSOSynchronized = False
        Sel.Clear
        Sel.Add Oj
        Call Vis.GetShow(ShowState)
        Sel.Clear
    CATIA.HSOSynchronized = True
    
    IsShow = IIf(ShowState = catVisPropertyDefined, True, False)
End Function

'クローン
Private Function DeepCopyCatCollection(ByVal CatCol As AnyObject, _
                                        ByVal OjType$) As Collection
    Set DeepCopyCatCollection = Nothing
    
    Dim Col As Variant
    Select Case OjType '面倒・・・
        Case "DrawingViews"
            Dim Vws As DrawingViews: Set Vws = CatCol
            Set Col = Vws
            
        Case "DrawingComponents"
            Dim Cmps As DrawingComponents: Set Cmps = CatCol
            Set Col = Cmps
            
        Case Else
            Set Col = CatCol
    End Select
    
    Dim Lst As Collection: Set Lst = New Collection
    Dim v
    For Each v In Col
        Lst.Add v
    Next
    Set DeepCopyCatCollection = Lst
End Function

これぐらいなら、それ程苦労せずに作成出来るのですが。