寸法をクリックし、2Dｺﾝﾎﾟｰﾈﾝﾄを配置する

こちらの続きです。
寸法をクリックして直交する線を書く - C#ATIA

・・・▽▽対策のマクロです。

'vba Finish_Mark_ver0.0.1  using-'KCL0.0.12'  by Kantoku

Option Explicit

'ｲﾝｽﾀﾝｽ作成用情報
Private Type CompBase
    view As DrawingView
    scale2 As Double
End Type

'参照寸法用
Private Type TargetDim
    dim As DrawingDimension
    pos As Variant
End Type

Private Const EPS = 0.0001          'ｲｺｰﾙ判断


Sub CATMain()
    'ﾄﾞｷｭﾒﾝﾄのﾁｪｯｸ
    If Not CanExecute("DrawingDocument") Then Exit Sub
    
    'ｲﾝｽﾀﾝｽﾍﾞｰｽの選択
    Dim cmp_base As CompBase
    cmp_base = SelectComp()
    If cmp_base.view Is Nothing Then Exit Sub
    
    'ﾓﾛﾓﾛ
    Dim doc As DrawingDocument
    Set doc = CATIA.ActiveDocument
    
    Dim sel As Selection
    Set sel = doc.Selection
    
    '配置ﾙｰﾌﾟ
    Dim msg As String
    
    Do
        Dim dim_info As TargetDim
        '参照する寸法選択
        dim_info = SelectDimension(sel)
        If dim_info.dim Is Nothing Then Exit Sub
        
        'ｱｸﾃｨﾌﾞﾋﾞｭｰ
        Dim ac As DrawingView
        Set ac = doc.Sheets.ActiveSheet.Views.ActiveView
        
        'ﾀｰｹﾞｯﾄﾋﾞｭｰ
        Dim tg As DrawingView
        Set tg = KCL.GetParent_Of_T(dim_info.dim, "DrawingView")
    
        'ﾋﾞｭｰ間ﾍﾞｸﾄﾙ
        Dim tran_vec As Variant
        tran_vec = GetTransVec(ac, tg)
        
        '該当するﾋﾞｭｰの座標に変換
        dim_info.pos = Add2d(tran_vec, dim_info.pos)
    
        '寸法線/補助線情報
        Dim dim_geo As Variant
        dim_geo = GetDimGeoInfo(dim_info.dim)
        
        '一番近い寸法線/補助線上の座標値を取得
        Dim cmp_pos As Variant
        cmp_pos = GetMinPos(dim_geo, dim_info.pos)
        
        'ｲﾝｽﾀﾝｽ作成
        Dim cmp As DrawingComponent
        Set cmp = tg.Components.Add(cmp_base.view, cmp_pos(0)(0), cmp_pos(0)(1))
        cmp.angle = GetAng(cmp_pos(1), cmp_pos(2), dim_info.pos)
        cmp.scale2 = cmp_base.scale2
        
        'doc.Update
        '確認
        '検索の表示で画面内に入っているかをﾁｪｯｸする?
        
        msg = "宜しいですか?" & vbCrLf & _
            "(はい-配置 , いいえ-反転して配置 , ｷｬﾝｾﾙ-配置を中止)"
        Dim btm_Opt As Long
        btm_Opt = vbYesNoCancel + vbInformation
        
        Select Case MsgBox(msg, vbYesNoCancel)
            Case vbYes
                'そのまま
            Case vbNo
                cmp.angle = cmp.angle - PI '2*PI超えるとｴﾗｰかも
            Case vbCancel
                sel.Clear
                sel.Add cmp
                sel.Delete
        End Select
        sel.Clear
    Loop
End Sub


'ﾃﾞｨﾃｰﾙｼｰﾄのﾋﾞｭｰか?
Private Function IsDetailSheetView(ByVal v As DrawingView) As Boolean
    Dim dmy As Variant
    
    On Error Resume Next
    err.Clear
    Set dmy = v.GenerativeLinks
    
    If err.Number = 0 Then
        IsDetailSheetView = False
    Else
        IsDetailSheetView = True
    End If
    
    err.Clear
    On Error GoTo 0
End Function

'ｲﾝｽﾀﾝｽﾍﾞｰｽの選択
Private Function SelectComp() As CompBase
    Dim msg$
    msg = "2Dｺﾝﾎﾟｰﾈﾝﾄ 又は ﾃﾞｨﾃｰﾙﾋﾞｭｰを選択 : ESCｷｰ 終了"
    
    Dim Itm As AnyObject
    Set Itm = KCL.SelectItem(msg, "DrawingComponent,DrawingView")
    If Itm Is Nothing Then Exit Function
        
    Dim cb As CompBase
    
    If TypeName(Itm) = "DrawingComponent" Then
        Set cb.view = Itm.CompRef
        cb.scale2 = Itm.scale2
        SelectComp = cb
        Exit Function
    End If
    
    If IsDetailSheetView(Itm) Then
        Set cb.view = Itm
        cb.scale2 = Itm.scale2 '1#
        SelectComp = cb
        Exit Function
    End If
    
    MsgBox "選択可能なﾋﾞｭｰは、ﾃﾞｨﾃｰﾙのもののみです"
End Function

'配置基準となる寸法選択
Private Function SelectDimension(ByVal sel As Variant) As TargetDim
    Dim msg As String
    msg = "寸法線をｸﾘｯｸして下さい"
    
    Dim filter As Variant
    filter = Array("DrawingDimension")
    
'ObjectSelectionBeforeCommandUsePossibility
'iTooltip
'iTriggeringOnMouseMove
'のどれかは直接IndicateOrSelectElement2Dに書いたほうが良い見たい
    
    'Select状態
    Dim ojSelected As Variant 'Boolean
    
    '値はｱｸﾃｨﾌﾞﾋﾞｭｰ上での座標値
    Dim winLocat(1) As Variant 'Double
    
    'マウスの状態
    Dim status As String
    status = "MouseMove"

    Dim tgt As TargetDim
    Do
        status = sel.IndicateOrSelectElement2D( _
            msg, _
            filter, _
            False, _
            False, _
            True, _
            ojSelected, _
            winLocat)
        
        If status = "Normal" And sel.Count2 > 0 Then
            Exit Do
        End If
        
        If status = "Cancel" Then
            Exit Function
        End If
    Loop
    Set tgt.dim = sel.Item(1).Value
    tgt.pos = winLocat
    
    SelectDimension = tgt
End Function

'ｺﾝﾎﾟｰﾈﾝﾄ配置角度算出
'param:s_pos-寸法線ｽﾀｰﾄ位置 e_pos-寸法線ｴﾝﾄﾞ位置 ref_pos-ｸﾘｯｸ位置
'return:角度単位rad
Private Function GetAng( _
    ByVal s_pos As Variant, _
    ByVal e_pos As Variant, _
    ByVal ref_pos As Variant) As Double
    
    '寸法線に対してのｸﾘｯｸ向きの算出
    Dim dim_vec As Variant
    dim_vec = Sub2d(s_pos, e_pos)
    
    Dim ref_vec As Variant
    ref_vec = Sub2d(s_pos, ref_pos)
    
    Dim crs_vec As Variant
    crs_vec = Cross2d(dim_vec, ref_vec)
    
    '寸法線角度
    Dim dim_rad As Double
    dim_rad = Atn2(dim_vec(1), dim_vec(0))
    
    GetAng = dim_rad
    If Sgn(crs_vec) > 0 Then
        GetAng = GetAng + PI
    End If
End Function

'複数線上と指定座標の最も近い位置の座標値取得
'0-線上xy 1-線始点xy 2-線終点xy
Private Function GetMinPos( _
    ByVal geos As Variant, _
    ByVal pos As Variant) As Variant
    
    Dim min As Double
    min = 1000000000
    
    Dim min_lin As Variant
    Dim tmp As Double
    Dim i As Long
    For i = 0 To UBound(geos)
        tmp = Dist_AB_C(geos(i)(0), geos(i)(1), pos)
        If tmp < min Then
            min = tmp
            min_lin = Array(geos(i)(0), geos(i)(1))
        End If
    Next
    
    '線上の最短点
    Dim min_nml As Variant
    min_nml = Normaliz2d(min_lin(0), min_lin(1))
    
    Dim lng As Double
    lng = Dot2d(min_nml, Sub2d(pos, min_lin(0)))
    
    Dim xy As Variant
    xy = Add2d(min_lin(0), Array(min_nml(0) * lng, min_nml(1) * lng))
    
    GetMinPos = Array(xy, min_lin(0), min_lin(1))
End Function

'ﾋﾞｭｰ間ﾍﾞｸﾄﾙ
Private Function GetTransVec( _
    ByVal act_v As DrawingView, _
    ByVal tgt_v As DrawingView) As Variant
    
    GetTransVec = Sub2d( _
        Array(act_v.xAxisData, act_v.yAxisData), _
        Array(tgt_v.xAxisData, tgt_v.yAxisData))
End Function

'寸法線、補助線座標値取得　0-寸,1-補1,2-補2
Private Function GetDimGeoInfo( _
    ByVal drwDim As DrawingDimension) As Variant
    
    Dim dl As Variant 'DrawingDimLine or DrawingDimExtLine
    Dim dimgeo(3) As Variant
    
    Set dl = drwDim.GetDimLine
    Call dl.GetGeomInfo(dimgeo)
    
    Dim ex1geo(3) As Variant
    Set dl = drwDim.GetDimExtLine
    Call dl.GetGeomInfo(1, ex1geo)
    
    Dim ex2geo(3) As Variant
    Call dl.GetGeomInfo(2, ex2geo)
    
    GetDimGeoInfo = Array( _
        Array(Array(dimgeo(0), dimgeo(1)), Array(dimgeo(2), dimgeo(3))), _
        Array(Array(dimgeo(0), dimgeo(1)), Array(ex1geo(0), ex1geo(1))), _
        Array(Array(dimgeo(2), dimgeo(3)), Array(ex2geo(0), ex2geo(1))) _
        )
End Function


'*** Math ***
Private Function PI() As Double
    PI = Atn(1) * 4
End Function

'ArcCos
Private Function ArcCos(ByVal v As Double) As Double
    ArcCos = Atn(-v / Sqr(-v * v + 1)) + 2 * Atn(1)
End Function

'Atn2
Private Function Atn2(ByVal y As Double, ByVal x As Double) As Double
    Select Case x
        Case Is > 0
            Atn2 = Atn(y / x)
        Case Is < 0
            Atn2 = Atn(y / x) + PI * Sgn(y)
            If y = 0 Then Atn2 = Atn2 + PI
        Case Is = 0
            Atn2 = (PI * 0.5) * Sgn(y)
    End Select
End Function

'2点距離の平方数
Private Function LengSqr(ByVal p1 As Variant, ByVal p2 As Variant) As Double
    Dim A#: A = p2(0) - p1(0)
    Dim B#: B = p2(1) - p1(1)
    LengSqr = A * A + B * B
End Function

'ｲｺｰﾙ
Private Function EQ(ByVal A As Double, ByVal B As Double) As Boolean
    EQ = IIf(Abs((A) - (B)) < EPS, True, False)
End Function


'vecter
'点A,Bを通過する無限直線と点Cとの距離
Private Function Dist_AB_C(ByVal A As Variant, ByVal B As Variant, ByVal C As Variant) As Double
    Dist_AB_C = Lng_AB_C(A, B, C)
End Function

'ﾍﾞｸﾄﾙABと点Cの距離
Private Function Lng_AB_C(ByVal A As Variant, ByVal B As Variant, ByVal C As Variant) As Double
    Lng_AB_C = Abs(Cross2d(Sub2d(B, A), Sub2d(C, A))) / Abs(Sqr(LengSqr(B, A)))
End Function

'単位ﾍﾞｸﾄﾙVと点Pの距離
Private Function Lng_V_P(ByVal v As Variant, ByVal p As Variant) As Double
    Lng_V_P = Abs(Cross2d(v, p))
End Function

'単位ﾍﾞｸﾄﾙ
Private Function Normaliz2d(ByVal V1 As Variant, ByVal V2 As Variant) As Variant
    Dim vec: vec = Sub2d(V2, V1)
    Dim tmp: tmp = Sqr(Dot2d(vec, vec))
    If EQ(tmp, 0#) Then
        Normaliz2d = Empty
        Exit Function
    End If
    Normaliz2d = Array(vec(0) / tmp, vec(1) / tmp)
End Function

'和2D
Private Function Add2d(ByVal V1 As Variant, ByVal V2 As Variant) As Variant
    Add2d = Array(V1(0) + V2(0), V1(1) + V2(1))
End Function

'差2D
Private Function Sub2d(ByVal V1 As Variant, ByVal V2 As Variant) As Variant
    Sub2d = Array(V1(0) - V2(0), V1(1) - V2(1))
End Function

'内積2D
Private Function Dot2d(ByVal V1 As Variant, ByVal V2 As Variant) As Double
    Dot2d = V1(0) * V2(0) + V1(1) * V2(1)
End Function

'外積2D
Private Function Cross2d(ByVal V1 As Variant, ByVal V2 As Variant) As Double
    Cross2d = V1(0) * V2(1) - V1(1) * V2(0)
End Function

・元のビューはこんな原点位置で考慮しており、角度もこれが0度としています。

・マクロ実行後、2Dｺﾝﾎﾟｰﾈﾝﾄかﾃﾞｨﾃｰﾙｼｰﾄのﾋﾞｭｰを選択し、その後寸法線・寸法補助線を
クリックすることで、2Dｺﾝﾎﾟｰﾈﾝﾄをそれなりの角度・位置で配置します。
但し、意図しない場合が多いため、一旦仮の配置を行ったのちこのようなダイアログが
出る為、必要に応じて反転させてください。（y4yamaさんのもこんな感じでした、確か）

・配置する際のスケールは元のスケールを保持します。

・通常、2Dｺﾝﾎﾟｰﾈﾝﾄはアクティブなビューに配置されますが、クリックした際の寸法が
存在しているビューに配置します。こちらの "残念、そこじゃないんだよね" 対策。
寸法をクリックして直交する線を書く - C#ATIA

・マクロ的に寸法線、寸法補助線はこちらの赤印部分の座標値しか取得できません。

この四点から緑色の線を想定し、クリック位置に一番近い線を選び出し線上の座標値を
算出する仕組みになっています。クリック座標の精度の悪さとの相乗効果で、矢印付近を
クリックした際、思惑とは90度異なったものが表示される可能性が有ります。

・上記の理由から角度寸法線のような曲線に対しては、正しく配置出来ません。

角度寸法だと判断し、すれなりに計算すれば対応できるのですが、頑張れません。
あまりする必要性も無いとは思ってます。

・累進寸法でファンネルを利用している場合、正しい位置には配置出来ません。

こちらに記載した、GetFunnelメソッドがエラーなる為、値の取得が出来ないからです。
ファンネル - C#ATIA

・このマクロが一年以内の出来るだけ早い段階で不要になることを、熱望しています。