C#ATIA

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

ファンネル2

こちらの続きです。
ファンネル - C#ATIA

どうも行き詰まり感が漂うので、とりあえずコードを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
せめて、両側で固定されるとありがたいのですが。

可能性が有りそうなのは、SetFunnelの第二引数のiMode
r1 DrawingDimExtLine (Object)
GetFunnelがエラーになるので、確認出来ないのが辛いです。
0~2ぐらいまでを試しただけなので何とも言えないのですが、
もっと多く試してみれば良いのかも。

とりあえず、お蔵入り・・・。