Catia: 2D Points to 3D Points - vba

Question

I have a Catia part where I have a few sketches on different planes. I need to be able to convert these sketches into 3D points which I copy to a new part document.
I have tried to use the Search and Selection commands in VB script in order to use a macro to pick up all the 2D points in my sketch and convert them to 3D points but to no avail.
Sub CATMain()
Set oSel = CATIA.ActiveDocument.Selection
strArray(0)=”Part”
Msgbox “Please select parts to join.”
sStatus = oSel.SelectElement3(strArray, “Select parts”, False, CATMultiSelTriggWhenUserValidatesSelection, false)
iCount = oSel.Count
For i= 1 to iCount
Set myObject2 = oSel.Item(i).value
oSel.Search “Name=Point,sel”
ReDim copies(iCount)
For k=1 to iCount
Set copies(k)=oSel.Item(k).Value
oSel.Add copies(k)
oSel.Copy
Next ‘k
Next ‘i
Set part2 = CATIA.Documents.Add(“CATPart”)
part2.Product.PartNumber = “My New Part”
Dim GSet1 As HybridBody
Set GSet1 = part2.Part.HybridBodies.Item(1)
GSet1.Name = “My Geometry”
Set partDocument2= CATIA.ActiveDocument
Dim ActSel As Selection
Set ActSel=partDocument2.Selection
ActSel.Add GSet1
ActSel.PasteSpecial(“CATPrtResultWithOutLink” )
ActSel.Clear
End Sub

Answer 1

You have to disassemble the sketch to get at the points as something you can copy
The disassemble command is exposed in VB via the HybridShapeFactory.AddNewDatums method.
Option Explicit
Sub CATMain()
Dim oPart As part
Set oPart = CATIA.ActiveDocument.part
Dim oHSF As HybridShapeFactory
Set oHSF = oPart.HybridShapeFactory
Dim sx As Sketch
Set sx = oPart.HybridBodies.item("Geometrical Set.1").HybridSketches.item("Sketch.1")
'make a temporary body
Dim targetGS As HybridBody
Set targetGS = oPart.HybridBodies.add
targetGS.name = "TMP_BODY___DELETE_ME"
'create a datum curve from the sketch
Dim sxRef As Reference
Set sxRef = oPart.CreateReferenceFromObject(sx)
'make a zero-translate from the sketch
'This is required because AddNewDatums functions needs a HybridShape feature
Dim oZero As HybridShapeTranslate
Set oZero = oHSF.AddNewTranslate(sxRef, oHSF.AddNewDirectionByCoord(0#, 0#, 1#), 0#)
Call targetGS.AppendHybridShape(oZero)
Call oPart.UpdateObject(oZero)
'now do the disassembly
Dim oZeroRef As Reference
Set oZeroRef = oPart.CreateReferenceFromObject(oZero)
'un-datum the curve by making a zero translate
Dim domains() As Variant
domains = oHSF.AddNewDatums(oZeroRef)
Dim i As Integer
For i = 0 To UBound(domains)
Call targetGS.AppendHybridShape(domains(i))
Next
Call oPart.Update
'now we can copy the resulting points...
Dim oSel As Selection
Set oSel = CATIA.ActiveDocument.Selection
Call oSel.add(targetGS)
Call oSel.Search("'Generative Shape Design'.Point,sel")
'copy paste into the new part
MsgBox ("There are " & oSel.count & " points ready to copy")
< YOUR COPY PASTE CODE GOES HERE>
'delete the temporary geo set
Call oHSF.DeleteObjectForDatum(oPart.CreateReferenceFromObject(targetGS))
End Sub