Continue to Site

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!

Not able to Add an item to a Selection

Status
Not open for further replies.

BoredDrawing

Automotive
Nov 2, 2010
3
Hello All,

Catia V5 R19 on XP64bit

I have recently been on the V5 VBA course, and I'm now writing my first program (how sweet!).

The program is to randomize the colours of parts within a product. The products are loaded from our PDM system (VPM via 3D Com to be precise) and it is likely that there are multiple levels or assemblies within the main root node.

The main elements of the program works, (looping up and down the structure, and changing the colour of a series of part within a flat product structure)

The problem that I have is that the program does not correclty select the part visibly in the catia screen. Interestingly the colour does change, but is not visible on the screen but only in the graphic properties toolbar when slecting the part manually in the spec tree.

Therfore the only thing that is not working is the passing the Added element to the selection for the colour to be visible. Any help would be appreciated, I assume that it is a syntax or a missunderstanding on my part.

Thanks.

Code:
Option Explicit 

Dim boShape As Boolean 
Dim pdDocument As ProductDocument 
Dim selProperty As Selection 
Dim lR As Long 
Dim lB As Long 
Dim lG As Long 

Sub Colour_Change() 

Dim stName As String 
Dim i As Integer 

On Error Resume Next 
Set pdDocument = CATIA.ActiveDocument 
stName = TypeName(CATIA.ActiveDocument) 

If Err.Description <> "" Then 
MsgBox "No Documents Loaded", vbCritical 
Exit Sub 
ElseIf stName <> "ProductDocument" Then 
MsgBox "This only works for Products", vbCritical 
Exit Sub 
End If 

Dim pdProducts As Products 

Set pdProducts = pdDocument.Product.Products 
Set selProperty = pdDocument.Selection 
selProperty.Clear 

Dim gmsShape As Object 
Dim refProduct As Product 


For i = 1 To pdProducts.Count 
boShape = pdProducts.Item(i).HasAMasterShapeRepresentation 
If boShape Then 

'---------------------- 
'This works 
'---------------------- 
selProperty.Add pdProducts.Item(i) 

lR = CInt(255 * Rnd()) 
lB = CInt(255 * Rnd()) 
lG = CInt(255 * Rnd()) 

selProperty.VisProperties.SetVisibleColor lR, lG, lB, 1 
selProperty.Clear 
Else 
Set refProduct = pdDocument.Product.Products.Item(i).ReferenceProduct 
Call LoopProduct(refProduct) 
End If 

Next 

End Sub 

Sub LoopProduct(refProductPass) 

Dim i As Integer 
Dim refProduct As Product 
Dim Test As AnyObject 

For i = 1 To refProductPass.Products.Count 

boShape = refProductPass.Products.Item(i).HasAMasterShapeRepresentation() 

If boShape Then 

lR = CInt(255 * Rnd()) 
lB = CInt(255 * Rnd()) 
lG = CInt(255 * Rnd()) 

'---------------------- 
'This doesn't work 
'---------------------- 
selProperty.Add refProductPass.Products.Item(i) 

selProperty.VisProperties.SetRealColor lR, lG, lB, 1 

selProperty.Clear 
Else 

Set refProduct = refProductPass.Products.Item(i).ReferenceProduct 
Call LoopProduct(refProduct) 

End If 

Next 

End Sub
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor