寸法をクリックして直交する線を書く

こちらの続きです。
http://kantoku.hatenablog.com/entry/2018/10/23/181308

こんな感じのDrawです。

正面図がアクティブな状態で、右側面図の寸法位置に▽▽の2Dコンポーネントを
配置しようとすると

正面図が大きくなりますし、当然レイアウトを変更したら根拠の全く無いマークが
残ります。標準の仕上記号であれば、同様の操作を行っても、きちっと
右側面図に入ってくれます。

寸法を移動しても仕上記号が付いてきてくれるので、もう一つ悩まされている
ファンネルにも対応できます。
（▽▽で行っていると手間が3～5倍ぐらいかかっている気がしてます）

まだ作りかけですが、寸法をクリックした位置に対して直交する線を描く
だけのテストマクロです。

'vba 寸法線クリックテスト  using-'KCL0.0.12'

Sub CATMain()
    Dim doc As DrawingDocument
    Set doc = CATIA.ActiveDocument
    
    Dim sel As Variant ' Selection
    Set sel = doc.Selection
    
    '座標選択
    Dim status As String
    status = "MouseMove"
    Dim ObjectSelected
    Dim WindowLocation(1)
    Dim filter As Variant
    filter = Array("DrawingDimension")
    
    'WindowLocationの座標値はｱｸﾃｨﾌﾞビューに対しての座標値
    Dim pos As Variant
    Do While (status = "MouseMove")
        status = sel.IndicateOrSelectElement2D( _
            "select", _
            filter, _
            False, _
            False, _
            True, _
            ObjectSelected, _
            WindowLocation)
        If Not ObjectSelected Then
            pos = WindowLocation
        End If
    Loop
    
    '選択寸法
    Dim drwDim As DrawingDimension
    Set drwDim = sel.Item(1).value
    
    'ｱｸﾃｨﾌﾞﾋﾞｭｰ
    Dim ac As DrawingView
    Set ac = doc.Sheets.ActiveSheet.Views.ActiveView
    
    'ﾀｰｹﾞｯﾄﾋﾞｭｰ
    Dim tg As DrawingView
    Set tg = KCL.GetParent_Of_T(drwDim, "DrawingView")
    
    'ﾋﾞｭｰ間ﾍﾞｸﾄﾙ
    Dim tran_vec As Variant
    tran_vec = GetTransVec(ac, tg)
    
    '該当するﾋﾞｭｰの座標に変換
    pos = Add2d(tran_vec, pos)
    
    '寸法線/補助線情報
    Dim dim_geo As Variant
    dim_geo = GetDimGeoInfo(drwDim)
    
    '一番近い寸法線/補助線上の座標値を取得
    Dim pp As Variant
    pp = GetMinPos(dim_geo, pos)
    
    '線作成
    Call InitLine2D(tg, pp, pos)
    
    doc.Update
End Sub

'複数線上と指定座標の最も近い位置の座標値取得
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 vec As Variant
    vec = Sub2d(pos, min_lin(0))
    
    Dim lng As Double
    lng = Dot2d(min_nml, vec)
    
    GetMinPos = Add2d(min_lin(0), Array(min_nml(0) * lng, min_nml(1) * lng))
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

'要素はﾋﾞｭｰをｱｸﾃｨﾌﾞにして作成する必要有り
'点の作成
Private Function InitPnt2D( _
    ByVal tgt_v As DrawingView, _
    ByVal pos As Variant, _
    Optional ByVal act_v As DrawingView = Nothing) As Point2D
    
    If act_v Is Nothing Then
        Set act_v = CATIA.ActiveDocument.Sheets.ActiveSheet.Views.ActiveView
    End If
    
    tgt_v.Activate
    
    Dim fact As Factory2D
    Set fact = tgt_v.Factory2D
    
    Set InitPnt2D = fact.CreatePoint(pos(0), pos(1))
    
    act_v.Activate
End Function

'線の作成
Private Function InitLine2D( _
    ByVal tgt_v As DrawingView, _
    ByVal p1 As Variant, _
    ByVal p2 As Variant, _
    Optional ByVal act_v As DrawingView = Nothing) As Line2D
    
    If act_v Is Nothing Then
        Set act_v = CATIA.ActiveDocument.Sheets.ActiveSheet.Views.ActiveView
    End If
    
    tgt_v.Activate
    
    Dim fact As Factory2D
    Set fact = tgt_v.Factory2D
    
    Set InitLine2D = fact.CreateLine(p1(0), p1(1), p2(0), p2(1))
    
    act_v.Activate
End Function


'*** Math ***
'ArcCos
Private Function ArcCos(ByVal V As Double) As Double
    ArcCos = Atn(-V / Sqr(-V * V + 1)) + 2 * Atn(1)
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
    If Dot2d(Sub2d(B, A), Sub2d(C, A)) < EPS Then
        Dist_AB_C = Abs(Sqr(LengSqr(C, A)))
        Exit Function
    End If
    If Dot2d(Sub2d(A, B), Sub2d(C, B)) < EPS Then
        Dist_AB_C = Abs(Sqr(LengSqr(C, B)))
        Exit Function
    End If
    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

他のマクロからコピペした関数だらけなので、使っていないものが多数入ってます。
IndicateOrSelectElement2Dのクリックした座標値の精度悪いですね。3Dも悪かったような。

モチベーションが低すぎて、完成するかわからない･･･。