こちらの続きです。
ファンネル2 - C#ATIA
行き詰まり感から脱していないです。
ゴールに辿り着ける気がしていないのが本音です。
赤い印の「ファンネル」部分にチェックが入っているかどうかを判断する
マクロが一応動く状態で出来上がっていますが、非常に限定的です。
・日本語環境のみ(ここは後でも修正できる)
・寸法のプロパティを開いた際、「寸法補助線」がアクティブな状態
'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も固まるのでご注意下さい。
(コールバック関数使うの嫌い・・・・)
タブを切り替える方法すらわからなかった・・・。