Measurements to Excel

[Wuzhee]

thread560-493796

Hi everyone,
Can someone with knowledge explain to me the attached code in the referenced thread?
I've got a small part where I measured surfaces. I want to export the Area parameters to an excel/csv. Preferably with the feature name.

Thank you all!

 

[rickyt]

Wuzhee,
Here is a catscript that will get you close, probably a few tweaks to get exactly what you want.
This requires pre-selecting what you want to be exported to excel.
Script will export a screen shot, file name, file path & the pre-selected attributes.
The attributes will be listed in the order that they were selected.

Dim objGEXCELapp As Object
Dim objGEXCELwkBks As Object
Dim objGEXCELwkBk As Object
Dim objGEXCELwkShs As Object
Dim objGEXCELSh As Object
Dim PartDocument1
Dim oSelection As Integer
Dim xlCenter As Integer
Dim xlBottom As Integer



Sub CATMain()

On Error Resume Next

Set partDocument1 = CATIA.ActiveDocument

Set oselection =CATIA.ActiveDocument.Selection

Dim MyWindow As SpecsAndGeomWindow
Dim MyViewer As Viewer3D

Set MyWindow = CATIA.ActiveWindow

MyWindow.Layout = catWindowGeomOnly

Catia.ActiveWindow.Viewers.item(1).CaptureToFile 1, "C:\Temp\OBMSectionR1.emf"

'MyWindow.Layout = catWindowSpecsOnly

MyWindow.Layout = catWindowSpecsAndGeom


'******************************************************************************

StartEXCEL

ExportParameter

UnLinkImage

End Sub

'******************************************************************************
Sub StartEXCEL()
'******************************************************************************
Err.Clear
On Error Resume Next
Set objGEXCELapp = GetObject (,"EXCEL.Application")

If Err.Number <> 0 Then
Err.Clear
Set objGEXCELapp = CreateObject ("EXCEL.Application")
End If

objGEXCELapp.Application.Visible = TRUE
Set objGEXCELwkBks = objGEXCELapp.Application.WorkBooks
Set objGEXCELwkBk = objGEXCELwkBks.Add
Set objGEXCELwkShs = objGEXCELwkBk.Worksheets(1)
Set objGEXCELSh = objGEXCELwkBk.Sheets (1)
objGEXCELSh.Cells (4,"A") = "Attribute"
objGEXCELSh.Cells (4,"B") = "Value"
objGEXCELSh.Cells (2,"A") = (partDocument1.Path)
objGEXCELSh.Cells (3,"A") = (partDocument1.Name)
objGEXCELSh.Cells (2,"B") = "File Path"
objGEXCELSh.Cells (3,"B") = "File Name"
objGEXCELSh.Cells (2,"A").WrapText = True
objGEXCELSh.Cells (3,"A").WrapText = True
objGEXCELSh.Range("A1:B1").MergeCells = True
objGEXCELSh.Range("A1:B1").border


End Sub
'''''''''''''''''''''''''''

'******************************************************************************
Sub ExportParameter()
'******************************************************************************
On Error Resume Next



Dim i As Integer
For i = 1 To oSelection.Count

Dim oSelectedElement As SelectedElement
Set oSelectedElement = oSelection.Item(i)

Dim sElementName As String
sElementName = oSelectedElement.Value.Name

Dim sElementValue As String
sElementValue = oSelectedElement.Value.Value

objGEXCELSh.Cells (i+4,"A") = sElementName
objGEXCELSh.Cells (i+4,"B") = sElementValue


next

Const xlCenter = -4108
'Const xlBottom = -4107


Dim Choice As String
'display an input box asking for number format format choice
Choice = InputBox( "0 x."& vbCrLf & "1 x.x" & vbCrLf & "2 x.xx" & vbCrLf & "3 x.xxx", "Choose decimal places 0,1, 2 or 3", "2")


If Choice = 1 then
tolx = "0.0"


ElseIf Choice = 2 Then
tolx = "0.00"

ElseIf Choice = 0 Then
tolx = "0"

Else
tolx = "0.000"


End If


objGEXCELSh.Columns("B").NumberFormat = tolx

objGEXCELSh.Columns("A").ColumnWidth = 40
objGEXCELSh.Columns("B").ColumnWidth = 15

objGEXCELSh.Rows("1").RowHeight = 150
objGEXCELSh.Rows("4").RowHeight = 25

objGEXCELSh.Columns("A:B").HorizontalAlignment = xlCenter
objGEXCELSh.Range("A4:B4").Font.Bold = True
objGEXCELSh.Range("A4").Font.Size = 20
objGEXCELSh.Range("B4").Font.Size = 20
objGEXCELSh.Range("A2").Font.Size = 10
objGEXCELSh.Range("A3").Font.Size = 10
objGEXCELSh.Range("A2:B2").Font.color = vbBlue
objGEXCELSh.Range("A3:B3").Font.color = vbBlue


'add borders to cells in excel
Dim rowcount as Integer
rowcount = oSelection.Count + 4
objGEXCELSh.Range("A4:B" & rowcount).Borders.LineStyle = 1
objGEXCELSh.Range("A4:B4").Interior.ColorIndex = 15
objGEXCELSh.Range("A2:B3").Interior.ColorIndex = 4

objGEXCELSh.Range("A4:B" & rowcount).Borders(7).Weight = 4
objGEXCELSh.Range("A4:B" & rowcount).Borders(8).Weight = 4
objGEXCELSh.Range("A4:B" & rowcount).Borders(9).Weight = 4
objGEXCELSh.Range("A4:B" & rowcount).Borders(10).Weight = 4

' Add Picture to cells a1 and b1
Dim rng As Range
Set rng = objGEXCELSh.Range("A1:B1")
Dim pic As Picture
Dim v As Variant

set pic = objGEXCELSh.Pictures.Insert("C:\Temp\OBMSectionR1.emf")

With pic
.ShapeRange.LockAspectRatio = msoTrue
.Height = rng.Height -6 'size 6 smaller than cells for border to show
.Width = rng.Width -6 'size 6 smaller than cells for border to show

End With
End Sub


Sub UnLinkImage()

objGEXCELSh.Shapes("Picture 2").Cut
objGEXCELSh.Range("A1:B1").Select
objGEXCELSh.Pictures.Paste.Select

Dim pic3 As Picture
Set pic3 = objGEXCELSh.Shapes("Picture 3")
pic3.Line.Weight = 2
pic3.Left = 3 'shift image 3 to center image in cell
pic3.Top = 3 'shift image 3 to center image in cell


End Sub