How search item to copy?

[gerlado]

Hi Again

Here it´s my code for read holes and thread, and show them in a worksheet of Excel


Sub export()

Dim partdocument1 As Document
Set partdocument1 = CATIA.ActiveDocument

Dim part1 As part
Set part1 = partdocument1.part

Dim bodies1 As Bodies
Set bodies1 = part1.Bodies

Dim body1 As Body
Set body1 = bodies1.Item("PartBody")

Dim shapes1 As Shapes
Set shapes1 = body1.Shapes


Dim selection1 As Selection
Set selection1 = CATIA.ActiveDocument.Selection

Dim i

selection1.Clear
For i = 1 To shapes1.Count
selection1.Add shapes1.Item(i)
Next

Dim xSelObj() As Variant
Dim xObj As Variant
Dim n As Integer
Dim myObj As AnyObject

Dim nCount As Integer
nCount = 0

For n = 0 To shapes1.Count

On Error Resume Next
Set myObj = selection1.FindObject("CATIAHole")

ReDim Preserve xSelObj(nCount)
Set xSelObj(nCount) = myObj
nCount = nCount + 1

Next



Dim sList As String
Dim nI As Integer



For nI = 0 To nCount - 3

Dim referenceX As Reference
Set referenceX = part1.CreateReferenceFromObject(xSelObj(nI))

Next

part1.Update

Dim Excel As Object
Dim Sheets As Object
Dim Sheet As Object


On Error Resume Next
Set Excel = GetObject(, "EXCEL.Application")
If Err.Number <> 0 Then
Err.Clear
Set Excel = CreateObject("EXCEL.Application")
Else
Err.Clear
MsgBox "Please note you have to close Excel", vbCritical
Exit Sub
End If

Excel.Visible = True

Dim workbooks
Dim myworkbook
Dim myworksheet

Set workbooks = Excel.Application.workbooks
Set myworkbook = Excel.workbooks.Add
Set myworksheet = Excel.ActiveWorkbook.Add
Set myworksheet = Excel.Sheets.Add

Excel.Cells(1, 4) = "diameter"
Excel.Cells(1, 5) = "thread"

Dim iAnzahlGew
selection1.Search "CATPrtSearch.Hole.Threaded=TRUE,all"
iAnzahlGew = selection1.Count

Dim valor As Integer
valor = 0


Dim Hole
For i = 1 To iAnzahlGew
Set Hole = selection1.Item2(i).Value
Excel.Cells(1 + i, 4) = Hole.Diameter.Value
Excel.Cells(1 + i, 5) = Hole.HoleThreadDescription.Value
valor = valor + 1
Next

If valor > 1 Then
valor = valor - 1
End If

Excel.Cells(3 + valor, 1) = "Holes"
Excel.Cells(2, 3) = selection1.Count ' numero de roscas


Dim iHoleInSelection
iHoleInSelection = True
Dim oPartDoc
Dim OBody
Set oPartDoc = CATIA.ActiveDocument
Set OBody = oPartDoc.part.Bodies.Item("PartBody")

Set selection1 = oPartDoc.Selection
selection1.Search "(Name=PartBody* & CATPrtSearch.BodyFeature),all"

Dim selection2
Set selection2 = oPartDoc.Selection

selection2.Search "CATPrtSearch.Hole.Threaded=FALSE,all"



For i = 1 To selection2.Count

Dim oHole
Dim oHoleName
Dim oHoleType

Set oHole = selection2.Item(i).Value
Set oHoleName = selection2.Item(i).Value
Set oHoleType = selection2.Item(i).Value

Excel.Cells(2 + valor + i, 4) = CStr(oHole.Diameter.Value)
Excel.Cells(2 + valor + i, 5) = CStr(oHoleName.Name)



Next
End Sub



Please, someone can you show me how read the circullar or rectangullar pattern, and how obtain the number of item to copy of each pattern?

Thanks