ｵﾌｾｯﾄ平面をﾘﾈｰﾑ

ｵﾌｾｯﾄ平面をそれなりの名前に変更するマクロです。
元々持っていたマクロなのですが、あまり使っていませんでした。
最近使ったのでｺｰﾄﾞを綺麗に直しました。

"それなりの名前に"　なのですが、サンプルとしてはこんな感じです。

平面1（黄色）-XY平面からｵﾌｾｯﾄ
平面2（ｵﾚﾝｼﾞ）-平面1からｵﾌｾｯﾄ
平面3（青）-座標系ZX平面からｵﾌｾｯﾄ
平面4（ｵﾚﾝｼﾞ）-平面3からｵﾌｾｯﾄ
の状態です。

マクロを実行し平面をクリックすると、こんな感じになります。

平面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