Hi all
I have written this script to extract and offset surfaces from the part the macro working but surfaces are offsetting in different direction some offset in opposite to the given direction as shown in below image with script
IMAGE File
VB SCRIPT
Option Explicit
Sub CATMain()
'Script - VB script
'Macro - Offset A surface
'Steps Involved
'Step-1: Get The active Document
'Step-2: Get The active part abd partDocument
'Get the Hybridbody collection
'Set the hybridbody which has surfaces
'create GeoSets
'Declare hybridShapes
'Declare selection and add hybridshapes to the selection
'Step-3: Search for the surfaces using selection either by color coding or by type
'Step-4: loop through collection and extract the surfaces
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Declare variables
Dim myDoc As Document
Set myDoc = CATIA.ActiveDocument
On Error Resume Next
Dim myPart As Part
Set myPart = CATIA.ActiveDocument.Part
Dim partDoc As PartDocument
Set partDoc = CATIA.ActiveDocument
Dim hybBodys As HybridBodies
Set hybBodys = myPart.HybridBodies
Dim inputBody As HybridBody
Set inputBody = hybBodys.Item("Styling Surface")
Dim hybShape As HybridShapes
Set hybShape = inputBody.HybridShapes
Dim hybShps As HybridShape
Set hybShps = hybShape.Item(1)
Dim oExtractbody As HybridBody
Set oExtractbody = myPart.HybridBodies.Add
oExtractbody.Name = "EXTRACT"
Dim oOffsetbody As HybridBody
Set oOffsetbody = myPart.HybridBodies.Add
oOffsetbody.Name = "OFFSET"
Dim hybShapefact As HybridShapeFactory
Set hybShapefact = myPart.HybridShapeFactory
CATIA.ActiveDocument.Selection.Clear
Dim osel As Selection
Set osel = CATIA.ActiveDocument.Selection
osel.Add hybShps
osel.Search ("Color='Dodger Blue',all")
Dim faceCollection As Collection
Set faceCollection = New Collection
Dim i As Integer
For i = 1 To osel.Count
Dim oExtract As HybridShapeExtract
Set oExtract = hybShapefact.AddNewExtract(osel.Item(i).Value)
oExtractbody.AppendHybridShape oExtract
myPart.UpdateObject oExtract
faceCollection.Add oExtract
myPart.Update
Next
Dim failcollection As Collection
Set failcollection = New Collection
For i = 1 To osel.Count
Dim oOffset As HybridShapeOffset
Set oOffset = hybShapefact.AddNewOffset(faceCollection.Item(i), 1, True, 0)
oOffsetbody.AppendHybridShape oOffset
On Error Resume Next
myPart.UpdateObject oOffset
If Err.Number <> 0 Then
CATIA.ActiveDocument.Selection.Clear
CATIA.ActiveDocument.Selection.Add oOffset
CATIA.ActiveDocument.Selection.Delete
CATIA.ActiveDocument.Selection.Clear
CATIA.ActiveDocument.Selection.Add faceCollection.Item(i)
CATIA.ActiveDocument.Selection.VisProperties.SetRealColor 255, 255, 0, 1
failcollection.Add i
Else
osel.Clear
osel.Add oOffset
Dim ovisualproperty As VisPropertySet
ovisualproperty.SetRealColor 255, 180, 255, 1
osel.Clear
End If
On Error GoTo 0
Next
End Sub
I have written this script to extract and offset surfaces from the part the macro working but surfaces are offsetting in different direction some offset in opposite to the given direction as shown in below image with script
IMAGE File
VB SCRIPT
Option Explicit
Sub CATMain()
'Script - VB script
'Macro - Offset A surface
'Steps Involved
'Step-1: Get The active Document
'Step-2: Get The active part abd partDocument
'Get the Hybridbody collection
'Set the hybridbody which has surfaces
'create GeoSets
'Declare hybridShapes
'Declare selection and add hybridshapes to the selection
'Step-3: Search for the surfaces using selection either by color coding or by type
'Step-4: loop through collection and extract the surfaces
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Declare variables
Dim myDoc As Document
Set myDoc = CATIA.ActiveDocument
On Error Resume Next
Dim myPart As Part
Set myPart = CATIA.ActiveDocument.Part
Dim partDoc As PartDocument
Set partDoc = CATIA.ActiveDocument
Dim hybBodys As HybridBodies
Set hybBodys = myPart.HybridBodies
Dim inputBody As HybridBody
Set inputBody = hybBodys.Item("Styling Surface")
Dim hybShape As HybridShapes
Set hybShape = inputBody.HybridShapes
Dim hybShps As HybridShape
Set hybShps = hybShape.Item(1)
Dim oExtractbody As HybridBody
Set oExtractbody = myPart.HybridBodies.Add
oExtractbody.Name = "EXTRACT"
Dim oOffsetbody As HybridBody
Set oOffsetbody = myPart.HybridBodies.Add
oOffsetbody.Name = "OFFSET"
Dim hybShapefact As HybridShapeFactory
Set hybShapefact = myPart.HybridShapeFactory
CATIA.ActiveDocument.Selection.Clear
Dim osel As Selection
Set osel = CATIA.ActiveDocument.Selection
osel.Add hybShps
osel.Search ("Color='Dodger Blue',all")
Dim faceCollection As Collection
Set faceCollection = New Collection
Dim i As Integer
For i = 1 To osel.Count
Dim oExtract As HybridShapeExtract
Set oExtract = hybShapefact.AddNewExtract(osel.Item(i).Value)
oExtractbody.AppendHybridShape oExtract
myPart.UpdateObject oExtract
faceCollection.Add oExtract
myPart.Update
Next
Dim failcollection As Collection
Set failcollection = New Collection
For i = 1 To osel.Count
Dim oOffset As HybridShapeOffset
Set oOffset = hybShapefact.AddNewOffset(faceCollection.Item(i), 1, True, 0)
oOffsetbody.AppendHybridShape oOffset
On Error Resume Next
myPart.UpdateObject oOffset
If Err.Number <> 0 Then
CATIA.ActiveDocument.Selection.Clear
CATIA.ActiveDocument.Selection.Add oOffset
CATIA.ActiveDocument.Selection.Delete
CATIA.ActiveDocument.Selection.Clear
CATIA.ActiveDocument.Selection.Add faceCollection.Item(i)
CATIA.ActiveDocument.Selection.VisProperties.SetRealColor 255, 255, 0, 1
failcollection.Add i
Else
osel.Clear
osel.Add oOffset
Dim ovisualproperty As VisPropertySet
ovisualproperty.SetRealColor 255, 180, 255, 1
osel.Clear
End If
On Error GoTo 0
Next
End Sub