C#ATIA

↑タイトル詐欺 主にFusion360API 偶にCATIA V5 VBA(絶賛ネタ切れ中)

ファンネル3

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

行き詰まり感から脱していないです。
ゴールに辿り着ける気がしていないのが本音です。
f:id:kandennti:20181114181940p:plain
赤い印の「ファンネル」部分にチェックが入っているかどうかを判断する
マクロが一応動く状態で出来上がっていますが、非常に限定的です。
・日本語環境のみ(ここは後でも修正できる)
・寸法のプロパティを開いた際、「寸法補助線」がアクティブな状態

'vba sample_IsFunnelOn ver0.0.1  using-'KCL0.0.12'  by Kantoku

'WinAPI
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" ( _
    ByVal lpClassName As String, _
    ByVal lpWindowName As String) As LongPtr

Private Declare PtrSafe Function ShowWindow Lib "user32" ( _
    ByVal hwnd As LongPtr, _
    ByVal nCmdShow As Long) As Long
Private Const SW_HIDE = 0
Private Const SW_SHOW = 5

'lpEnumFunc:Longだと型不一致エラー →LongPtrもしくはLongLong
Private Declare PtrSafe Function EnumChildWindows Lib "user32" ( _
    ByVal hwndParent As LongPtr, _
    ByVal lpEnumFunc As LongPtr, _
    ByVal lParam As LongPtr) As Long

Private Declare PtrSafe Function SendMessageAny Lib "user32" Alias "SendMessageA" ( _
    ByVal hwnd As LongPtr, _
    ByVal wMsg As Long, _
    ByVal wParam As Long, _
    lParam As Any) As Long
Private Const WM_CLOSE = &H10
Private Const BM_GETCHECK = &HF0

Private Declare PtrSafe Function SendMessageStr Lib "user32" Alias "SendMessageA" ( _
    ByVal hwnd As LongPtr, _
    ByVal wMsg As Long, _
    ByVal wParam As Long, _
    ByVal lParam As String) As Long
Private Const WM_GETTEXT = &HD

'member
Private m_Caption As String
Private m_hwnd As LongPtr

Option Explicit

Sub CATMain()
    'ドキュメントのチェック
    If Not CanExecute("DrawingDocument") Then Exit Sub
    
    Dim sel As Selection
    Set sel = CATIA.ActiveDocument.Selection
    
    Dim msg As String
    
    Dim drawDim As DrawingDimension
    Dim fun As Long
    Do
        msg = "寸法を選択 // [Esc]=Cancel"
        Set drawDim = KCL.SelectItem(msg, "DrawingDimension")
        If drawDim Is Nothing Then Exit Do
        
        sel.Clear
        sel.Add drawDim
        fun = IsFunnelOn()
        sel.Clear
        
        Select Case fun
            Case Is < 0
                MsgBox "日本語環境になっているか" & vbCrLf & _
                    "プロパティを[寸法補助線]タブに切り替えてください" _
                    , vbExclamation
                Exit Do
            Case 0
                msg = "ファンネルはOffになっています"
            Case Else
                msg = "ファンネルはOnになっています"
        End Select
        MsgBox msg
    Loop
End Sub

Private Function IsFunnelOn() As Long
    IsFunnelOn = -1
    
    Dim cmd As String
    cmd = "プロパティ"
    
    'コマンド実行
    CATIA.StartCommand cmd
    CATIA.RefreshDisplay = True
    
    'プロパティダイアログのハンドル取得
    Dim hwnd As LongPtr
    hwnd = FindWindow("#32770", cmd)
    If hwnd < 1 Then GoTo func_end
    
    'ダイアログ非表示
    ShowWindow hwnd, SW_HIDE
    
    'ファンネルボタンのハンドル取得
    m_Caption = "ファンネル"
    m_hwnd = -1
    
    Call EnumChildWindows(hwnd, AddressOf SearchChildWindow, 0)
    If m_hwnd < 0 Then GoTo func_end
    
    Dim fun_hwnd As LongPtr
    fun_hwnd = m_hwnd
    
    'ファンネルボタンの状態取得
    IsFunnelOn = SendMessageAny(fun_hwnd, BM_GETCHECK, 0, 0)
    
    'コマンド終了
func_end:
    ShowWindow hwnd, SW_SHOW
    SendMessageAny hwnd, WM_CLOSE, 0, 0
End Function

'コールバック
Private Function SearchChildWindow(ByVal hwnd As LongPtr, ByVal prm As Long) As Boolean
    Dim idx As Integer
    Dim cap As String * 256
    
    idx = SendMessageStr(hwnd, WM_GETTEXT, 255, cap)
    cap = Left(cap, idx)
    
    If InStr(1, cap, m_Caption) > 0 Then
        m_hwnd = hwnd
    End If
    SearchChildWindow = True
End Function

使用する為の条件が限定的過ぎる上、画面もチラつくし、遅い。
運が悪いとCATIAも固まるのでご注意下さい。
(コールバック関数使うの嫌い・・・・)
タブを切り替える方法すらわからなかった・・・。