CATIA V5 Macro - Get Links
Please read Liability Disclaimer and License Agreement CAREFULLY
Streamline your Catia V5 workflow with this VBA application that extracts links from parts, assemblies, and drawings.
Save time and improve efficiency with our powerful tool.
The size of this movie is about 12Mb so be patient ...
VB Code that reads Catia V5 Edit->Links Command and provide the content of the window to be used as needed by the user.
Class Module "LinkItem"
Public FromElement As String
Public ToElement As String
Public InInstance As String
Public PointedDocument As String
Public Publication As String
Public LinkType As String
Public Owner As String
Public Status As String
Public LastSynchronized As String
Public ActiveStatus As StringModule "iLink"
Option Explicit
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long Private Declare Function SendMessageStr Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
Private Declare Function SendMessageAny Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long Private Declare Function EnumChildWindows Lib "user32" (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Integer) As Integer
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetForegroundWindow Lib "user32" () As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function VirtualAllocEx Lib "kernel32" (ByVal hProcess As Long, ByVal lpAddress As Long, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
Private Declare Function VirtualFreeEx Lib "kernel32" (ByVal hProcess As Long, lpAddress As Any, ByVal dwSize As Long, ByVal dwFreeType As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Private Const SW_HIDE = 0
Private Const SW_SHOW = 5
Private Const GW_HWNDNEXT = 2
Private Const WM_GETTEXT = &HD
Private Const WM_CLOSE = &H10
Private Const HDM_GETITEMCOUNT = (&H1200 + 0) Private Const LVM_FIRST As Long = &H1000
Private Const LVM_GETITEMCOUNT = (LVM_FIRST + 4)
Private Const LVM_GETITEM As Long = (LVM_FIRST + 5)
Private Const LVM_GETHEADER = (LVM_FIRST + 31)
Private Const LVM_SETITEMSTATE = (LVM_FIRST + 43)
Private Const LVM_GETITEMSTATE = (LVM_FIRST + 44)
Private Const LVM_GETITEMTEXT = LVM_FIRST + 45 Private Const LVIS_SELECTED = &H2 Private Const LVIF_TEXT = &H1
Private Const LVIF_STATE = &H8& Private Const PAGE_READWRITE = &H4&
Private Const MEM_RESERVE = &H2000
Private Const MEM_COMMIT = &H1000
Private Const MEM_RELEASE = &H8000
Private Const PROCESS_VM_OPERATION = &H8
Private Const PROCESS_VM_READ = &H10
Private Const PROCESS_VM_WRITE = &H20 Private F_hwnd As Long 'Forma
Private L_hwnd As Long 'Lista
Private iLinks As New Collection
Private Type LVITEM
mask As Long
iItem As Long
iSubitem As Long
state As Long
stateMask As Long
pszText As Long
cchTextMax As Long
iImage As Long
lParam As Long
iIndent As Long
End Type
Private ListCount As Integer Public Function GetV5Liks() As Collection
CATIA.StartCommand ("Links...")
CATIA.RefreshDisplay = True
F_hwnd = FindWindowLike("Links of document")
ShowWindow F_hwnd, SW_HIDE
Sleep 100
EnumChildWindows F_hwnd, AddressOf EnumChildWindow, 0
Dim Rows, CrtR As Integer
Rows = SendMessageStr(L_hwnd, LVM_GETITEMCOUNT, 0, 0)
'Cols = SendMessageStr(HH, HDM_GETITEMCOUNT, 0, 0)
Rows = SendMessageStr(L_hwnd, LVM_GETITEMCOUNT, 0, 0)
Dim RetColl As New Collection
For CrtR = 0 To Rows - 1
Dim lItem As New LinkItem
lItem.FromElement = ListViewGetText(0, CrtR)
lItem.ToElement = ListViewGetText(1, CrtR)
lItem.InInstance = ListViewGetText(2, CrtR)
lItem.PointedDocument = ListViewGetText(3, CrtR)
lItem.Publication = ListViewGetText(4, CrtR)
lItem.LinkType = ListViewGetText(5, CrtR)
lItem.Owner = ListViewGetText(6, CrtR)
lItem.Status = ListViewGetText(7, CrtR)
lItem.LastSynchronized = ListViewGetText(8, CrtR)
lItem.ActiveStatus = ListViewGetText(9, CrtR)
RetColl.Add lItem
Set lItem = Nothing
Next
ShowWindow F_hwnd, SW_SHOW
SendMessageAny F_hwnd, WM_CLOSE, 0, 0
Set GetV5Liks = RetColl
End Function
Private Function EnumChildWindow(ByVal hChild As Long, ByVal lParam As Long) As Long
Dim iClass As String
Dim iText As String
Dim j As Integer
iClass = Space(256)
j = GetClassName(hChild, iClass, 63)
iClass = Left(iClass, j)
iText = Space(256)
j = SendMessageStr(hChild, WM_GETTEXT, 255, iText)
iText = Left(iText, j)
If iClass = "SysListView32" Then
ListCount = ListCount + 1
If ListCount = 2 Then
L_hwnd = hChild: EnumChildWindow = 0: Exit Function
End If
End If
EnumChildWindow = 1 ' Continua enumerarea
End Function
Private Function FindWindowLike(strPartOfCaption As String) As Long
Dim hwnd As Long
Dim strCurrentWindowText As String
Dim r As Integer
hwnd = GetForegroundWindow
Do Until hwnd = 0
strCurrentWindowText = Space$(255)
r = GetWindowText(hwnd, strCurrentWindowText, 255)
strCurrentWindowText = Left$(strCurrentWindowText, r)
If InStr(1, LCase(strCurrentWindowText), LCase(strPartOfCaption)) <> 0 Then GoTo Found
hwnd = GetWindow(hwnd, GW_HWNDNEXT)
Loop
Exit Function
Found:
FindWindowLike = hwnd
End Function
Private Function ListViewGetText(ByVal iSubitem As Integer, ByVal iItem As Integer) As String
Dim lngProcID As Long, lngProcHandle As Long
Dim typLvItem As LVITEM, strLvItem As String
Dim lngVarPtr1 As Long, lngVarPtr2 As Long
Dim lngMemVar1 As Long, lngMemVar2 As Long
Dim lngMemLen1 As Long, lngMemLen2 As Long
Call GetWindowThreadProcessId(L_hwnd, lngProcID)
If lngProcID <> 0 Then
lngProcHandle = OpenProcess(PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE, False, lngProcID)
If lngProcHandle <> 0 Then
strLvItem = Space$(255) 'String(255, vbNullChar)
lngVarPtr1 = StrPtr(strLvItem)
lngVarPtr2 = VarPtr(typLvItem)
lngMemLen1 = LenB(strLvItem)
lngMemLen2 = LenB(typLvItem)
lngMemVar1 = VirtualAllocEx(lngProcHandle, 0, lngMemLen1, MEM_RESERVE Or MEM_COMMIT, PAGE_READWRITE)
lngMemVar2 = VirtualAllocEx(lngProcHandle, 0, lngMemLen2, MEM_RESERVE Or MEM_COMMIT, PAGE_READWRITE)
With typLvItem
.cchTextMax = 255
.iItem = iItem
.iSubitem = iSubitem
.mask = LVIF_TEXT
.pszText = lngMemVar1
End With
Call WriteProcessMemory(lngProcHandle, ByVal lngMemVar1, ByVal lngVarPtr1, lngMemLen1, 0)
Call WriteProcessMemory(lngProcHandle, ByVal lngMemVar2, ByVal lngVarPtr2, lngMemLen2, 0)
Call SendMessageAny(L_hwnd, LVM_GETITEM, ByVal 0, ByVal lngMemVar2)
Call ReadProcessMemory(lngProcHandle, ByVal lngMemVar1, ByVal lngVarPtr1, lngMemLen1, 0)
strLvItem = StrConv(strLvItem, vbUnicode)
strLvItem = Left(strLvItem, InStr(1, strLvItem, vbNullChar) - 1)
ListViewGetText = strLvItem
Call VirtualFreeEx(lngProcHandle, ByVal lngMemVar1, lngMemLen1, MEM_RELEASE)
Call VirtualFreeEx(lngProcHandle, ByVal lngMemVar2, lngMemLen2, MEM_RELEASE)
Call CloseHandle(lngProcHandle)
End If
End If
End FunctionForm "GVI_GetCatiaLinks"
Option Explicit
Dim q As New Collection
Public Sub UserForm_Initialize()
Dim i As Integer
Dim LstItem As ListItem
Dim LinkItm As New LinkItem
Set q = iLink.GetV5Liks
Debug.Print q.Count
With iList.ColumnHeaders
.Add , , "No", 25
.Add , , "FromElement", 55
.Add , , "ToElement", 55
.Add , , "InInstance", 55
.Add , , "PointedDocument", 55
.Add , , "Publication", 55
.Add , , "LinkType", 55
.Add , , "Owner", 55
.Add , , "Status", 55
.Add , , "LastSynchronized", 55
.Add , , "ActiveStatus", 55
End With
For i = 1 To q.Count
Set LstItem = iList.ListItems.Add()
With LstItem
.Text = i
Set LinkItm = q.Item(i)
.SubItems(1) = LinkItm.FromElement
.SubItems(2) = LinkItm.ToElement
.SubItems(3) = LinkItm.InInstance
.SubItems(4) = LinkItm.PointedDocument
.SubItems(5) = LinkItm.Publication
.SubItems(6) = LinkItm.LinkType
.SubItems(7) = LinkItm.Owner
.SubItems(8) = LinkItm.Status
.SubItems(9) = LinkItm.LastSynchronized
.SubItems(10) = LinkItm.ActiveStatus
Set LinkItm = Nothing
End With
Set LstItem = Nothing
Next
End SubMain Catia Module "FindTheLink"
Sub CATMain()
If TypeName(CATIA.ActiveDocument) = "PartDocument" Or TypeName(CATIA.ActiveDocument) = "ProductDocument" Or TypeName(CATIA.ActiveDocument) = "DrawingDocument" Then
GVI_GetLinks.Show
Else
MsgBox TypeName(CATIA.ActiveDocument) & " unsupported document!"
Exit Sub
End If
End Sub
Comments powered by CComment