Catia Offset Macro

[NaVVin55]

Hi
i wrote a macro to offset multiple surfaces at once and its working fine but the surfaces are not offsetting in one direction instead some surfaces are offsetting inside and some are offsetting outside
Here is the image

Here is the macro script
Option Explicit
Sub CATMain()

Dim myDoc As Document
Set myDoc = CATIA.ActiveDocument

Dim myPart As part
Set myPart = CATIA.ActiveDocument.part

Dim partDoc As PartDocument
Set partDoc = CATIA.ActiveDocument

Dim hfac As HybridShapeFactory
Set hfac = myPart.HybridShapeFactory

Dim hybBody As HybridBodies
Set hybBody = myPart.HybridBodies

Dim hybB As HybridBody
Set hybB = myPart.HybridBodies.Item("Styling Surface")

Dim hybB1 As HybridBody
Set hybB1 = hybBody.Add
hybB1.Name = "Extract"

Dim hybB2 As HybridBody
Set hybB2 = hybBody.Add
hybB2.Name = "Offset"

Dim hyShapes As HybridShapes
Set hyShapes = hybB.HybridShapes

Dim hyShape As HybridShape
Set hyShape = hyShapes.Item(1)

CATIA.ActiveDocument.Selection.Clear

Dim oSel As Selection
Set oSel = CATIA.ActiveDocument.Selection
oSel.Add hyShape
oSel.Search ("Topology.Face,all")

Dim faceCollection As Collection
Set faceCollection = New Collection

Dim visProp
Set visProp = oSel.VisProperties

Set oSel = CATIA.ActiveDocument.Selection
Dim i As Integer
For i = 1 To oSel.Count
Dim oExtract As HybridShapeExtract
Set oExtract = hfac.AddNewExtract(oSel.Item(i).Value)
hybB1.AppendHybridShape oExtract
myPart.UpdateObject oExtract
faceCollection.Add oExtract
Next
CATIA.ActiveDocument.Selection.Clear

Dim hybShDir As HybridShapeDirection
Set hybShDir = hfac.AddNewDirectionByCoord(0, 0, 1)

Err.Clear

Dim poinSur As HybridShapePointOnSurface
Set poinSur = hfac.AddNewPointOnSurface(faceCollection.Item(1), hybShDir, 0)
hybB2.AppendHybridShape poinSur
myPart.UpdateObject poinSur

Dim ref1 As Reference
Set ref1 = myPart.CreateReferenceFromObject(poinSur)

Dim hybShDir2 As HybridShapeDirection
Set hybShDir2 = hfac.AddNewDirection(faceCollection.Item(1))

Dim hybShLine As HybridShapeLineNormal
Set hybShLine = hfac.AddNewLineNormal(faceCollection.Item(1), ref1, 0, 60, False)
hybB2.AppendHybridShape hybShLine
myPart.UpdateObject hybShLine
myPart.Update

Dim failCollection As Collection
Set failCollection = New Collection

Dim hybShDir3 As HybridShapeDirection
Set hybShDir3 = hfac.AddNewDirection(faceCollection(1))

For i = 1 To 101
Dim offset As HybridShapeOffset
Set offset = hfac.AddNewOffset(faceCollection.Item(i), 2, False, 0)
offset.Compute
offset.OffsetDirection = True
hybB2.AppendHybridShape offset
On Error Resume Next
myPart.UpdateObject offset
If Err.number <> 0 Then
CATIA.ActiveDocument.Selection.Clear
CATIA.ActiveDocument.Selection.Add offset
CATIA.ActiveDocument.Selection.Delete
CATIA.ActiveDocument.Selection.Clear
CATIA.ActiveDocument.Selection.Add faceCollection.Item(i)
failCollection.Add i
Err.Clear
Else
oSel.Clear
oSel.Add offset
oSel.Clear
End If
On Error GoTo 0
myPart.Update
Next

End Sub

How to write macro to offset surfaces in only one direction
Thanks

 

[MBCatia]

Hello,

Sorry your work is good but it is already there is a command offset in generatvie shape design mode.

Do you know that?

Best regards.

 

[NaVVin55]

Yes i know
but you cant offset many surfaces at once with that command
what if there are 500 or 1000 surfaces
so i need to know how do i offset using macro

 

[MBCatia]

If surface near and maksimum 0,1 mm gap.
Make surfaces join first then make offset if you want.

Maybe a way.

And your macro ability soo good.

Take it easy
Mesut

 

[Little Cthulhu]

Looks like a duplicate -

https://www.eng-tips.com/viewthread.cfm?qid=468660