'Macro for creation of "Old Revision" references - Written by: P. Kim
'================================================================
Option Explicit 'forces variable declaration
Language="VBSCRIPT"
Sub CATMain()
msgbox ("This macro is to be used on part file only, not product.")
'Declare and set variables
Dim partDocument1
Set partDocument1 = CATIA.ActiveDocument
Dim part1
Set part1 = partDocument1.Part
Dim hybridShapeFactory1
Set hybridShapeFactory1 = part1.HybridShapeFactory
Dim hybridBodies1
Set hybridBodies1 = part1.HybridBodies
Dim hybridBody1, geoCount, i
Dim bodies1
Set bodies1 = part1.Bodies
Dim Selection, Selection2
Set Selection = partDocument1.Selection
Dim partDocument2
Set partDocument2 = CATIA.ActiveDocument
Set Selection2 = partDocument2.Selection
Selection.Clear
'-----Code Starts Here-----
'check if existing "Old" geo set
geoCount = 0
For i = 1 to hybridBodies1.Count
hybridBodies1.Item(i)
If hybridBodies1.Item(i).Name = "Old" Then
geoCount = 1
Exit For
End If
Next
If geoCount = 0 Then
Set hybridBody1 = hybridBodies1.Add()
hybridBody1.Name = "Old"
End If
Dim InputObjectType(0), Status, Status2
'ask for input (body to be referenced)'
msgbox ("Please select the body to reference.")
InputObjectType(0) = "Body"
Status = Selection.SelectElement2(InputObjectType, "Select a feature", true)
if (Status = "Cancel") then Exit Sub
Dim body1
Set body1 = Selection.Item(1).Value
msgbox body1.Name
'create new reference of "body1" (selected body above)'
Dim reference1
Set reference1 = part1.CreateReferenceFromObject (body1)
msgbox reference1.Name
Dim hybridShapeExtract1
Set hybridShapeExtract1 = hybridShapeFactory1.AddNewExtract(reference1)
hybridShapeExtract1.PropagationType = 1
hybridShapeExtract1.ComplementaryExtract = False
hybridShapeExtract1.IsFederated = False
'set geo set for extract to reside in
Set hybridBody1 = hybridBodies1.Item("Old")
'create extract'
hybridBody1.AppendHybridShape hybridShapeExtract1
'part1.InWorkObject = hybridShapeExtract1
part1.Update
Dim reference2
Set reference2 = part1.CreateReferenceFromObject (hybridShapeExtract1)
Dim hybridShapeSurfaceExplicit1
Set hybridShapeSurfaceExplicit1 = hybridShapeFactory1.AddNewSurfaceDatum(reference2)
'create extract (with history)
hybridBody1.AppendHybridShape hybridShapeSurfaceExplicit1
part1.InWorkObject = hybridShapeSurfaceExplicit1
part1.Update
'isolate linked extract
hybridShapeFactory1.DeleteObjectForDatum (reference2)
Dim visProperties1, SelectedElements
Set SelectedElements = partDocument1.Selection
Set visProperties1 = SelectedElements.VisProperties
SelectedElements.Clear()
SelectedElements.Add(hybridBody1)
'change colour of extract to "red"
visProperties1.SetRealColor 255,0,0,1
'change opacity of extract to 0
visProperties1.SetRealOpacity 0,1
SelectedElements.Clear()
part1.Update
End Sub