Set oSelection = CATIA.ActiveDocument.Selection
May 7, 2006 09:01 PM
(in response to COE Administrator)
Here is my script
the interesting thing is that it works as designed on a windows R14
but not on a unix (sun hp) R14
it bulks at that oselection
At the moment it adds a new catpart if no document is available
however i would like to choose between a catpart or product, also i
have an issue if the product contains no catparts my script does
not work cause it requires yoiu to select the part in the product
to upgrade. any ideas my code is a bit rusty
Madaxe
Language="VBSCRIPT"
Sub CATMain()
'*******************************************************
'Define the objectives, user variables, initial set-up *
'*******************************************************
Dim SB, GS As Integer 'SB IS NUMBER OF BODIES, GS IS NUMBER OF
GEOMETRICAL SETS AS BELOW
'Number of New Solid Bodies (SB) to be inserted:
SB = 3
'_____/
Dim SolBody(3) As String
'**************************************************************
'These are the Bodies to be inserted. PartBody to be renamed. *
'**************************************************************
SolBody(0) = "MASTER_MODEL" 'Renames the PartBody
SolBody(1) = "POSITIVE_FEATURES"
SolBody(2) = "NEGATIVE_FEATURES"
SolBody(3) = "MACHINED_FEATURES"
'MATCH THE SB VALUE ABOVE WITH LAST NUMBER OF THE SolBody
'Number of Geometrical Sets (GS) to be inserted:
GS = 4
'_____/
Dim GeoSet(4) As String
'**************************************************************
'These are the Geometrical Sets to be inserted. *
'**************************************************************
GeoSet(1) = "REFERENCE_ELEMENTS"
GeoSet(2) = "SKETCHES"
GeoSet(3) = "SECTIONS"
GeoSet(4) = "MISC"
'MATCH THE GS VALUE ABOVE WITH LAST NUMBER OF THE GeoSet
'***********************************************************************************
'***********************************************************************************
'Start calculations. Modify at your own risk, or better DO NOT
MODIFY
'***************************
'Declares script variables *
'***************************
Dim documents1 As Documents
Dim partDocument1 As Document
Dim part1 As Part
Dim bodies1 As Bodies
Dim body1 As Body
Dim hybridBodies1 As HybridBodies
Dim hybridBody1 As HybridBody
Dim body1name, hybridBody1name, oFather As AnyObject
Dim I, J As Integer
Dim InputObjectType(0)
Dim oSelection As Selection
Dim strPartName, sSelectedPart, strDocName, strDocType, strBodyName
As String
'**************************
'Variables initialization *
'**************************
For N = 1 To CATIA.Documents.Count
NumOfDocs = CATIA.Documents.Count
Next
If NumOfDocs = 0 Then
Set documents1 = CATIA.Documents
Set partDocument1 = documents1.Add("Part")
End If
Set documents1 = CATIA.Documents
' Create a selection Object, then clear any current selection
Set oSelection = CATIA.ActiveDocument.Selection
oSelection.Clear
' Check document type and assign to variable
strDocName = CATIA.ActiveDocument.Name
If (InStrRev(strDocName, ".CATPart", -1) <> 0) Then
strDocType = "PART"
End If
If (InStrRev(strDocName, ".CATProduct", -1) <> 0) Then
strDocType = "PRODUCT"
End If
Select Case strDocType ' For each document type, obtain the part to
work with
Case "PART"
Set partDocument1 = CATIA.ActiveDocument
Case "PRODUCT"
' User Selects Part (can only select Part)
InputObjectType(0) = "Part"
sSelectedPart = oSelection.SelectElement(InputObjectType, "Select
the part to be upgraded to Start Part", true)
If (sSelectedPart = "ok" OR sSelectedPart = "Normal") Then ' This
allows for pressing the Escape key to cancel macro.
' Set selected Part
Set oFather = oSelection.Item(1).Value
strPartName = oFather.Name & ".CATPart"
oSelection.Clear
Set partDocument1 = documents1.Item(strPartName)
Else
Exit Sub ' because the user pressed the Escape key to abort the
Macro.
End If
Case Else ' it is not anything we want to work with
MsgBox "A Part or Product must be the active document to run this
macro"
Exit Sub
End Select
Set part1 = partDocument1.Part
Set bodies1 = part1.Bodies
Set hybridBodies1 = part1.HybridBodies
'**********************************
'Verifies PartBody and renames it *
'**********************************
Set body1 = bodies1.Item(1)
If (body1.name <> "PartBody") Then
Dim messagePartBody As String
messagePartBody = "Part Body was already renamed
"&body1.name&". It will not be renamed "&SolBody(0)
MsgBox messagePartBody
Else
body1.name = SolBody(0)
MsgBox "PartBody was renamed "&SolBody(0)
End If
'**********************
'Adds required Bodies *
'**********************
number = bodies1.Count
Dim messolexists, messolinsert As string
messolexists = "The following Bodies exist and were not duplicated:
"
messolinsert = "The following Bodies were inserted: "
FOR I = 1 TO SB
'Verifies existence of predefined bodies
For K = 1 TO number
Set body1 = bodies1.Item(K)
If (body1.name = SolBody(I)) Then
messolexists = messolexists&SolBody(I)&", "
K = number
End If
Next
If(InStr(52, messolexists, SolBody(I),1) = 0) Then
Set body1 = bodies1.Add()
body1.name = SolBody(I)
messolinsert = messolinsert&SolBody(I)&", "
End If
NEXT
'Displays the results of Solid Body insertion
If(InStr(52, messolexists, ", ", 1) <> 0) Then
MsgBox messolexists
End If
If(InStr(36, messolinsert, ", ", 1) <> 0) Then
MsgBox messolinsert
Else
MsgBox "No new bodies were inserted."
End If
'*********************************
'Adds required Geometrical Sets *
'*********************************
number = hybridBodies1.Count
Dim mesopnexists, mesopninsert As string
mesopnexists = "The following Geometrical Sets (Open Bodies) exist
and were not duplicated: "
mesopninsert = "The following Geometrical Sets (Open Bodies) were
inserted: "
FOR J = 1 TO GS
'Verifies existence of predefined Geometrical Sets
For K = 1 TO number
Set hybridBody1 = hybridBodies1.Item(K)
If (hybridBody1.name = GeoSet(J)) Then
mesopnexists = mesopnexists&GeoSet(J)&", "
K = number
End If
Next
If(InStr(76, mesopnexists, GeoSet(J),1) = 0) Then
Set hybridBody1 = hybridBodies1.Add()
hybridBody1.name = GeoSet(J)
mesopninsert = mesopninsert&GeoSet(J)&", "
End If
NEXT
'Displays the results of Geometrical Set insertion
If(InStr(76, mesopnexists, ", ", 1) <> 0) Then
MsgBox mesopnexists
End If
If(InStr(60, mesopninsert, ", ", 1) <> 0) Then
MsgBox mesopninsert
Else
MsgBox "No new Geometrical Sets (Open Bodies) were inserted."
End If
part1.Update
'***********************************************************************************
'***********************************************************************************
Set body1 = bodies1.Item("MASTER_MODEL")
part1.InWorkObject = body1
part1.InWorkObject = bodies1.Item("MASTER_MODEL")
Set shapeFactory1 = part1.ShapeFactory
Set body2 = bodies1.Item("POSITIVE_FEATURES")
Set assemble1 = shapeFactory1.AddNewAssemble(body2)
part1.Update
part1.InWorkObject = body1
Set body3 = bodies1.Item("NEGATIVE_FEATURES")
Set assemble2 = shapeFactory1.AddNewAssemble(body3)
part1.Update
part1.InWorkObject = body1
Set body4 = bodies1.Item("MACHINED_FEATURES")
Set assemble3 = shapeFactory1.AddNewAssemble(body4)
part1.Update
assemble1.name = "POS_ASSY"
assemble2.name = "NEG_ASSY"
assemble3.name = "MAC_ASSY"
Set body1 = bodies1.Item("MASTER_MODEL")
part1.InWorkObject = body1
MsgBox "POSITIVE_FEATURES, NEGATIVE_FEATURES &
MACHINED_FEATURES were assembled to MASTER_MODEL."
'***********************************************************************************
'***********************************************************************************
JM = inputBox ("WHAT IS THE PART NUMBER")
Set partDocument1 = CATIA.ActiveDocument
Set product1 = partDocument1.GetItem("Part1")
If JM = "" Then
JM = "NO PART NUMBER"
End If
product1.PartNumber = (JM)
'***********************************************************************************
'***********************************************************************************
End Sub