C#ATIA

↑タイトル詐欺 主にCATIA V5 の VBA(最近はPMillマクロとFusion360APIが多い)

オフセット平面をリネーム

オフセット平面をそれなりの名前に変更するマクロです。
元々持っていたマクロなのですが、あまり使っていませんでした。
最近使ったのでコードを綺麗に直しました。

"それなりの名前に" なのですが、サンプルとしてはこんな感じです。
f:id:kandennti:20180426191222p:plain
平面1(黄色)-XY平面からオフセット
平面2(オレンジ)-平面1からオフセット
平面3(青)-座標系ZX平面からオフセット
平面4(オレンジ)-平面3からオフセット
の状態です。

マクロを実行し平面をクリックすると、こんな感じになります。
f:id:kandennti:20180426191230p:plain
平面1は、XY平面からオフセットの為、Z=+20に
平面2は、平面1からオフセットの為、"Z=+20" +20 と言う意味合いで
平面3は、座標系ZX平面からオフセットの為、リネームしない
平面4は、平面3からオフセットの為、”平面3” +20 と言う意味合いで
とリネームします。あくまで参照元が平面の場合のみなんです。
オフセット平面を座標系派の方、ごめんなさい。 結構難しいんです。

'vba Part_OffsetPleneRename_ver0.0.1  using-'KCL0.0.12'  by Kantoku
Option Explicit

Sub CATMain()
    'ドキュメントのチェック
    If Not CanExecute("PartDocument,ProductDocument") Then Exit Sub
    
    Dim Msg As String
    Msg = "オフセット平面を選択して下さい : ESCキー 終了"
    Dim pln As Plane
    
    Do
        Set pln = KCL.SelectItem(Msg, "Plane")
        If pln Is Nothing Then Exit Do
        
        'オフセット平面以外を除去
        If Not IsPlaneOffset(pln) Then
            MsgBox "指定面はオフセット平面ではありません"
            GoTo Continue
        End If
        
        '参照が平面オブジェクト以外を除去
        If InStr(pln.Plane.DisplayName, "RSur:") > 0 Then
            MsgBox "参照面が平面ではありません"
            GoTo Continue
        End If
        
        'リネーム
        With pln
            .Name = GetPlaneName(.Plane) & _
                    Num2Str(.Offset.Value * .Orientation)
        End With
Continue:
    Loop
End Sub

'オフセット平面?
Private Function IsPlaneOffset(ByVal pln As Plane) As Boolean
    Dim tmp As HybridShapePlaneOffset
    On Error Resume Next
        Set tmp = pln
        If Err.Number <> 0 Then
            IsPlaneOffset = False
        Else
            IsPlaneOffset = True
        End If
    On Error GoTo 0
End Function

'数値を+-付きの文字にする
Private Function Num2Str(ByVal num As Double) As String
    Num2Str = IIf(num > 0, "+", "") & CStr(num)
End Function
 
'新たな平面名取得
Private Function GetPlaneName(ByVal RefPlnName As Reference) As String
    Select Case RefPlnName.DisplayName
        Case "xy plane", "XY平面"
            GetPlaneName = "Z="
        Case "yz plane", "YZ平面"
            GetPlaneName = "X="
        Case "zx plane", "ZX平面"
            GetPlaneName = "Y="
        Case Else
            GetPlaneName = RefPlnName.DisplayName
    End Select
End Function