Eng-Tips is the largest engineering community on the Internet

Intelligent Work Forums for Engineering Professionals

  • Congratulations waross on being selected by the Eng-Tips community for having the most helpful posts in the forums last week. Way to Go!

Offset multiple surfaces VB SCRIPT

Status
Not open for further replies.

NaWin55

Mechanical
Mar 21, 2020
97
IN
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
Offset_i7m0cs.jpg


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
 
Replies continue below

Recommended for you

You're making a statement, not asking a question.

And the right question is: what is a "correct" direction?
 
@Little Cthulhu

Ya i forgot to ask properly
i need to know how to offset surfaces in only one direction
Thanks
 
And the right question is: what is a "correct" direction?

Please read my post carefully.

Let's suppose you have a square-based pad:

[pre]|--|
| |
|--|[/pre]

And now you offset it's "left" and "right" faces away from pad's center:

[pre] |--|
| |
|--|[/pre]

Did they move in "one" direction? Obviosuly, they didn't.

So the question is: do you want all surfaces to move in one single direction (along same vector) or move in different directions away from a reference point?
 
i want the surfaces to move in SINGLE DIRECTION (along a same vector)
Just like when we offset we give one direction and reverse direction if we want, in my macro some surfaces are offsetting in reverse direction even though i gave positive value
Just like when we do A surface to B surface conversion we offset the surfaces to some value (part thickness value)

so how do correct the macro to offset in same direction either inside or outside

Thanks
 
i want the surfaces to move in SINGLE DIRECTION (along a same vector)

In such case I suggest to get direction associated with each face with HybridShapeFactory.AddNewDirection(refFace) (don't forget to call Compute) and make sure it is the same across all faces:

Code:
Dim dir as HybridShapeDirection
set dir = hybridShapeFact.AddNewDirection(faceCollection(1))
dir.Compute
Dim coords: coords = Array(dir.GetXVal(), dir.GetYVal(), dir.GetZVal())

for i=1 to osel.Count
  set dir = hybridShapeFact.AddNewDirection(faceCollection(i))
  dir.Compute
  if coords(0) = dir.GetXVal() and coords(0) = dir.GetYVal() and coords(2) = dir.GetZVal() then
    Set oOffset = hybShapefact.AddNewOffset(faceCollection.Item(i), 1, True, 0)
  else
    Set oOffset = hybShapefact.AddNewOffset(faceCollection.Item(i), 1, False, 0)
  end if
...
 
Hi

Below is the macro for offset which is working fine.
May I request you to suggest how to include the direction option in this MACRO.

How to get the validation from user for direction "TRUE or FALSE"

Language="VBSCRIPT"

Sub CATMain()

Set partDocument1 = CATIA.ActiveDocument

Set part1 = partDocument1.Part

Set hybridBodies1 = part1.HybridBodies

Offsetvalue = Inputbox("Enter the value offset")

Dim InputObjectType(0)

msgbox ("Select the geometrical set")

Set oSelection = CATIA.ActiveDocument.Selection
oSelection.Clear
InputObjectType(0) = "HybridBody"
Status = oSelection.SelectElement2(InputObjectType, "Select Geometrical set.", True)

Set hybridBody1 = hybridBodies1.Add()
Set hybridBody1 = CATIA.ActiveDocument.Part.InWorkObject

Dim iCount
Dim i 'As Integer

oSelection.Search "CATGmoSearch.Surface,sel" '-----With this all the surfaces will be searched
iCount = oSelection.Count '-----Each selected item is counted

For i =1 to iCount

Set USel = CATIA.ActiveDocument.Selection
'MsgBox(USel.Item(i).Value.Name)


On Error Resume Next

Set hybridShapeFactory1 = part1.HybridShapeFactory

Set hybridShapeSurfaceExplicit1 = oSelection.Item(i).Value

Dim reference1 'As Reference

Set reference1 = part1.CreateReferenceFromObject(hybridShapeSurfaceExplicit1)

Set hybridShapeOffset1 = hybridShapeFactory1.AddNewOffset(reference1, Offsetvalue, True, 0.010000)

Set hybridBodies1 = part1.HybridBodies

hybridBody1.AppendHybridShape hybridShapeOffset1

part1.InWorkObject = hybridShapeOffset1

part1.Update

'----->> This if loop below will esnure that failed offset will be deactivated.
If Err.Number <> 0 Then

part1.Inactivate hybridShapeOffset1

End If
Next
part1.Update

msgbox ("Total number of surfaces offseted are " &iCount)

Set partDocument1 = CATIA.ActiveDocument
oSelection.Clear '--- Its mandatory to clear previous selection to clear

Set selection1 = partDocument1.Selection

selection1.Search "CATGmoSearch.Surface.Activity=FALSE,all"

dCount = oSelection.Count

msgbox ("Total Deactivated surfaces are " &dCount)

End Sub






 
How to get the validation from user for direction "TRUE or FALSE"

Replace this line:
Code:
Set hybridShapeOffset1 = hybridShapeFactory1.AddNewOffset(reference1, Offsetvalue, True, 0.010000)

with:
Code:
Set hybridShapeOffset1 = hybridShapeFactory1.AddNewOffset(reference1, Offsetvalue, vbYes = MsgBox("Select direction", vbYesNo + vbQuestion, "Offset direction"), 0.010000)
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top