Continue to Site
'****************************************************************************
'This macro extracts 3D coordinates for points and creates a complete table on CAT drawing.
'with X, Y and Z coordinates.
'Instructions for use:
'Drawing as window 2.
'Select points and run macro, input table headline and letter.
'Table with 3D coordinates will be created in the view "TABLES".
'Created by Per Björk, 2014
'****************************************************************************
Dim coords(2) As Variant
Dim letter, tabHeadline as String
Dim numberOfPoints, selWin as Integer
Dim foundTables as Boolean
Sub CATmain()
'selWin = inputBox ("Which window contains the drawing? Ex. 1, 2, 3...")
tabHeadline= inputBox("Table headline?")
letter = inputBox ("Which letter? Ex. A, B, C...")
'*************************************************************
dim selection1 as Selection
Set selection1 = CATIA.ActiveDocument.selection
numberOfPoints = selection1.Count
'*************************************************************
Set myWin = CATIA.Windows.Item(2) 'activate drawing window
myWin.Activate
Dim myDoc As DrawingDocument 'define active document and drawing view
Set myDoc = CATIA.ActiveDocument
Dim mySheet As DrawingSheet
Set mySheet = myDoc.Sheets.Activesheet
for i = 1 to mySheet.Views.Count 'check if drawing view "TABLES" exists
Dim myView as DrawingView
set myView = mySheet.Views.Item(i)
Dim MyPrefix, MyIdent, MySuffix As CATBSTR 'initate getViewName
MyView.GetViewName MyPrefix, MyIdent, MySuffix
if MyPrefix = "TABLES" then 'if "TABLES" exists activate view and exit for loop
Set myView = mySheet.Views.Item("TABLES")
myView.Activate
foundTables = TRUE
Exit for
end if
next
if foundTables = FALSE then 'if "TABLES" doesn't exist, create and activate it
Set myView = mySheet.Views.Add("TABLES")
myView.Activate
end if
'create the table itself
Dim MyTable As DrawingTable
Set MyTable = MyView.Tables.Add(100, 100,numberOfPoints + 2 , 4, 7.5, 20)
'add labels
MyTable.SetCellString 1, 1, tabHeadline
MyTable.SetCellString 2, 1, "POINT"
MyTable.SetCellString 2, 2, "X"
MyTable.SetCellString 2, 3, "Y"
MyTable.SetCellString 2, 4, "Z"
MyTable.MergeCells 1, 1, 1, 4
MyTable.SetCellAlignment 1,1, CatTableTopCenter
'*******************************************************************
For i = 1 To numberOfPoints 'create correct number of rows
Set element = selection1.Item(i)
Set selPoint = element.Value
Set TheSPAWorkbench = CATIA.ActiveDocument.GetWorkbench("SPAWorkbench") ' set TheSPAWorkbench
Set TheMeasurable = TheSPAWorkbench.GetMeasurable(selPoint) ' set Measurable with reference
TheMeasurable.GetPoint coords ' get coordinates from Measurable
'add point name
MyTable.SetCellString 2 + i, 1, letter & i
xPoint = round(coords(0),1) 'check decimals
if int(xPoint) / xPoint = 1 then 'check if integer
MyTable.SetCellString 2 + i, 2, xPoint & ",0" 'add ",0"
else
MyTable.SetCellString 2 + i, 2, round(coords(0), 1) 'else, use 1 decimal
end if
yPoint = round(coords(1),1) 'same procedure for y and z
if int(yPoint) / yPoint = 1 then
MyTable.SetCellString 2 + i, 3, yPoint & ",0"
else
MyTable.SetCellString 2 + i, 3, round(coords(1), 1)
end if
zPoint = round(coords(2),1)
if int(zPoint) / zPoint = 1 then
MyTable.SetCellString 2 + i, 4, zPoint & ",0"
else
MyTable.SetCellString 2 + i, 4, round(coords(2), 1)
end if
Next
MsgBox "Coordinate table created!" & vbNewline & "Points are presented in order of selection."
End Sub