Option Explicit '// COPYRIGHT DASSAULT SYSTEMES 2000 '****************************************************************************** ' Purpose: This CATScript demonstrates how to create an Area with ' a contour. ' Assumptions: This assumes that a macro is being executed interactively. ' Author : ' Languages : VBScript ' CATIA Level: V5R6 ' Locale : English '****************************************************************************** Sub CATMain() ' On Error Resume Next '---------------------------------------------- 'Create a new product document Dim objProdDoc As ProductDocument Dim objRootProd As Product Set objProdDoc = CATIA.Documents.Add("Product") Set objRootProd = objProdDoc.Product '---------------------------------------------- 'Retrieving Root Product's Relative Axis and Position Information Dim objMove As Move Dim objPosition As Position Set objMove = objRootProd.Move Set objPosition = objRootProd.Position '---------------------------------------------- ' Get ArrangementProduct Dim objArrProd As ArrangementProduct Set objArrProd = objRootProd.GetTechnologicalObject("ArrangementProduct") '---------------------------------------------- ' Create Area without a contour under the Root Product Dim objArea As ArrangementArea Dim dblAreaPos(11) As Double objPosition.GetComponents dblAreaPos Set objArea = objArrProd.ArrangementAreas.AddArea(objMove, dblAreaPos, 50.0) '---------------------------------------------- ' Create Rectangle Dim objRectangle As ArrangementRectangle Dim objArrProd1 As ArrangementProduct Dim objAreaProd1 As Product Dim objMove1 As Move Dim objPosition1 As Position Dim dblRectPos(11) As Double Set objAreaProd1 = objArea.GetTechnologicalObject("Product") Set objArrProd1 = objArea.GetTechnologicalObject("ArrangementProduct") Set objMove1 = objAreaProd1.Move Set objPosition1 = objAreaProd1.Position objPosition1.GetComponents dblRectPos dblRectPos(9) = 100.0 dblRectPos(10) = 100.0 dblRectPos(11) = 0.0 Set objRectangle = objArrProd1.ArrangementRectangles.AddRectangle (objMove1,dblRectPos, 50.0, 50.0) '--------------------------------------------- ' Add Rectangular contour to Area objArea.ArrangementContours.AddRectangularContour(objRectangle) End Sub