CATIA V5 Macro - Get Links

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 String
 

Module "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 Function
Form "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 Sub

Main 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

Who’s online

We have 282 guests and no members online