ファンネル2

どうも行き詰まり感が漂うので、とりあえずコードをUpします。

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

Option Explicit

Private Const DEF_FUNNEL_VALUE = "2,15,5"
Private Const TITLE = "ファンネル設定"

Sub CATMain()
    'ﾄﾞｷｭﾒﾝﾄのﾁｪｯｸ
    If Not CanExecute(Array("DrawingDocument")) Then Exit Sub
    
    Dim msg1 As String
    msg1 = "ファンネル設定値を入力して下さい (高さ,角度,幅)" & vbCrLf & _
           "例) 2,15,5 - 高さ2 角度45°幅5 外側" & vbCrLf & _
           "　　2,-15,5 - 高さ2 角度45°幅5 内側" & vbCrLf & _
           "　　2,0,5 -角度0°でファンネル無しと同等です"
    
    Dim msg2 As String
    msg2 = "累進寸法を選択して下さい : ESCｷｰ ファンネル数値再設定"
    
    
    Dim funnel_value As String
    funnel_value = DEF_FUNNEL_VALUE
    
    Dim funnel As Variant
    Dim drawDim As DrawingDimension
    
    Do
        'ファンネル設定入力
        funnel_value = InputBox(msg1, TITLE, funnel_value)
        
        If StrPtr(funnel_value) = 0 Then Exit Sub
        
        funnel = ConvertFunnelValue(funnel_value)
        If Not UBound(funnel) = 3 Then Exit Do
        
        Do
            '寸法選択
            Set drawDim = SelectItem(msg2, "DrawingDimension")
            If IsNothing(drawDim) Then Exit Do
            
            '累進チェック
            If Not IsCumulateDistance(drawDim) Then
                MsgBox "累進寸法のみです!!", vbExclamation
                GoTo continue
            End If
            
            '実行
            Call ExecFunnel(drawDim, funnel(0), funnel(1), funnel(2), funnel(3))
continue:
        Loop
    Loop
    
    MsgBox "Done"
End Sub

'累進寸法判断
Private Function IsCumulateDistance(drawDim As DrawingDimension) As Boolean
    IsCumulateDistance = False
    
    With drawDim
        If .CumulateMode = False Then Exit Function
        If Not .DimType = catDimDistance Then Exit Function
    End With
    
    IsCumulateDistance = True
End Function

'入力値判断
Private Function ConvertFunnelValue(ByVal v As String) As Variant
    ConvertFunnelValue = Array(0#)
    
    Dim ary As Variant
    ary = Split(v, ",")
    
    If Not UBound(ary) = 2 Then Exit Function
    
    Dim i As Long
    For i = 0 To UBound(ary)
        If Not IsNumeric(ary(i)) Then Exit Function
    Next
    
    '角度でﾓｰﾄﾞ切り替え
    Dim mode As Double
    If CDbl(ary(1)) < 0 Then
        '内側
        mode = 1#
    Else
        '外側
        mode = 0#
    End If
    
    ConvertFunnelValue = Array(mode, CDbl(ary(0)), CDbl(ary(1)), CDbl(ary(2)))
End Function

'ファンネル実行
Private Sub ExecFunnel(ByVal drawDim As DrawingDimension, _
                       ByVal mode As Double, _
                       ByVal height As Double, _
                       ByVal angle As Double, _
                       ByVal width As Double)
    Dim dimExt As Variant ' DrawingDimExtLine
    Set dimExt = drawDim.GetDimExtLine
    
    If angle = 0 Then
        height = dimExt.GetOverrun(2)
        width = 0#
    End If
    Call dimExt.SetFunnel(2#, mode, Abs(angle), height, width)
End Sub

マクロを実行後インプットボックスが表示されます。
ファンネル設定値を　高さ , 角度 , 幅　の順でカンマ区切りで
入力して下さい。
f:id:kandennti:20181031200134p:plain
基本的にファンネルモードは外側です。内側にしたい場合は、
角度を0　又は　幅をマイナスの値で入力して下さい。

その後、累進寸法をクリックすることでファンネルを設定します。
マクロ実行中にファンネル設定値を変更したい場合は、ESCキーを
押す事で、再度インプットボックスが表示されます。
（その為、作業終了する際はESCキーを2度押す必要が有ります）

・・・と書くと結構良さそうに聞こえるけど、問題だらけです。

このマクロは赤印の4ヶ所のみを変更します。
f:id:kandennti:20181031200148p:plain
緑色のラジオボタンは入っていない状態でも、マクロの実行で
入ってしまいます。
逆にファンネルをOFFにしたくても、マクロでは届かない処理の
ようなので、代替として
・高さを紫色の数値に変更
・幅を0に変更
することで、見た目はファンネルをOFFと同等なる為（多分）
そのような処理をしています。

もう一点、こちらは致命傷です。
このような累進寸法を入れたとします。
f:id:kandennti:20181031200213p:plain
「30」の寸法を全てマクロを実行しクリックした
状態がこちら
f:id:kandennti:20181031200220p:plain
実に残念な結果に･･･。
原因はわかっており、ファンネルサイドがマクロを実行すると
必ず「右または上」になってしまうからなんです。
f:id:kandennti:20181031200227p:plain
せめて、両側で固定されるとありがたいのですが。