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!

Remove a color using "No Color"

Status
Not open for further replies.

badbad214

New member
Sep 14, 2010
3
thread560-129853
Catia V5 R18 on XP, VBA

Hello,
I am working in the context of a CATProduct which does contain many levels of "assemblies" (components). Those components have different attribute such as the assembly type and the status (Shared SH, Release RL and Frozen FR in my case). I order to help designer to filter their catproduct on the attributes for DMU purpose I created an user form which allow the designer to color all assemblies at the FR status or all assemblies RL status.... so once the designer has selected what he wants the data is colored, the color is applied on the assembly level which color the parts by inheritance. So the color of of the assembly is changed from "No Color" to a RVB color (SelectionX.SetVisibleColor()). Now if I want the designer to be able to proceed again and color another selection I need to be able to remove the colors I just applied. That is for the context of what I am trying to do.
The question:
What is the VB code to apply a "No Color" value on an part which has been selected? (properties-> graphic-> graphic properties-> color-> "No Color).

I hope I was clear in the description of my issue (I know how to do the selection just I do not know how to remove the color I just applied on an assembly without closing the catprodut).

Any help would be appreciated.
Thank you
Regards
Alexandre Bessy
 
Replies continue below

Recommended for you

I have looked at this in Knowledgeware to set a hole back to NONE but could only set to the default colour hex code of "#D2D2FF" There are some things you can not access in the API or language browsers.

Regards,
Derek




Win XP64
R20/21, 3DVIA Composer 2012, ST R20
Dell T7400 16GB Ram
Quadro FX 4800 - 1.5GB
 
I afraid of something like that but I really appreciate you taking the time to look into it.

Thank you
Regards
Alexandre Bessy
 
Hi

All these are old codes , I didn't tested on newer versions of CATIA. Hope I understood well your problem and maybe this can help you a little bit in your search.
In a CATScript, code to reset graphic properties (to default, of course):

Code:
Sub CATMain()
Dim partDocument1 As PartDocument
Set partDocument1 = CATIA.ActiveDocument
Dim part1 As part
Set part1 = partDocument1.part
Dim bodies1 As Bodies
Set bodies1 = part1.Bodies
Dim body1 As Body
Set body1 = bodies1.Item(1)
Dim specsAndGeomWindow1 As SpecsAndGeomWindow
Set specsAndGeomWindow1 = CATIA.ActiveWindow
Dim viewer3D1 As Viewer3D
Set viewer3D1 = specsAndGeomWindow1.ActiveViewer
viewer3D1.Reframe
Dim viewpoint3D1 As Viewpoint3D
Set viewpoint3D1 = viewer3D1.Viewpoint3D
Set viewpoint3D1 = viewer3D1.Viewpoint3D
CATIA.StartCommand "* Iso"
Dim selection1 As Selection
Set selection1 = partDocument1.Selection
selection1.Add body1
CATIA.StartCommand "Reset Properties"
selection1.Clear
Dim cmd As String
cmd = "wscript c:\SendEnter.vbs"
End Sub

Code for vbs file
Code:
Set WshShell = WScript.CreateObject("WScript.Shell")
WScript.sleep 200
WshShell.SendKeys "{ENTER}"

Of course you can do it in vba, it will be much easier.

Or you can use something else (also in CATScript) :) :

Code:
' Purpose:         Change color of the selected elements

Option Explicit
Sub CATMain()

    Dim TabSelectedProduct() As Product
    Dim oProductRoot As Product
    Dim oProduct As Product 
    Dim iNumberSel As Integer
    Dim iIndexSel As Integer
    Dim iNumberBodies As Integer
    Dim iNumberShapes As Integer
    Dim sInputObjectType(0) As String
    Dim oObject As AnyObject
    Dim r As long, g As long, b As Long
    Dim layer As long
    Dim layertype As CatVisLayerType 	
    Dim oVisProperties1 As VisPropertySet
    Dim oDocument As Document
    Dim oSelection As Selection	
    Dim Status As String
    Dim index As Integer
    Dim iErr As Integer
    Dim MechPart As Part
    Dim j As Integer
    Dim body As Body
    Dim oShapes As Shapes
    Dim oShape As Shape
    Dim k As Integer

    ' Retrieve the current selection
    Set oDocument = CATIA.ActiveDocument
    Set oSelection = oDocument.Selection
 	
    ' The work mode must be the design mode
    Set oProductRoot = CATIA.ActiveDocument.Product
    oProductRoot.applyWorkMode(DESIGN_MODE)

    CATIA.RefreshDisplay = True

    ' ------------------------------------------------------
    ' read the products to be colored

Msgbox "Select a product to be colored"

    sInputObjectType(0) = "Product"
    Status = oSelection.SelectElement2(sInputObjectType,"Select a product to be colored",True)
    If (Status = "Cancel") Then Exit Sub

    ' Fill a table with products selected
    iNumberSel = oSelection.Count
    If (iNumberSel = 0) then 
        MsgBox "You must select 1 to N Parts to be colored.", vbCritical, "Selection"
    End If

    Redim TabSelectedProduct(oSelection.Count - 1)
   
    iIndexSel=0
    On Error Resume Next
    While (Err.Number = 0)
       Set oProduct = oSelection.FindObject("CATIAProduct")
       If (Err.Number = 0) Then
            Set TabSelectedProduct(iIndexSel) = oProduct
            iIndexSel =  iIndexSel+1
       End If
    Wend
    On Error Goto 0
 	
    oSelection.Clear
  		 
    ' -----------------------------------------------------
    ' read the reference 
 	' The user set the new color
    
    Msgbox "Select a reference Body For Color"
    
 	sInputObjectType(0) = "Body"
 	Status = oSelection.SelectElement2(sInputObjectType,"Select a reference Body For Color",True)
 	If (Status = "Cancel") Then Exit Sub
 	
 	r = CLng(0) 
 	g = CLng(0) 
 	b = CLng(0) 

 	Set oObject = oSelection.Item(1).Value
	Set oVisProperties1 = oSelection.VisProperties
 	call oVisProperties1.GetVisibleColor (r, g, b) 

 	oSelection.Clear()

   ' -------------------------------------------------------
   ' Build the selection for new color

 	'Loop on the table to put all the object on selection
 	For Index = 1 to iNumberSel
 		Set oProduct = TabSelectedProduct(Index - 1)
 		
 	    On Error Resume next
 			Set MechPart = oProduct.GetMasterShapeRepresentation(true).Part
 			iErr = Err.Number
			On Error Goto 0 ' Invalidates the Resume next and clears the error

			If (iErr<>0) Then
				' User must select part
                        MsgBox " The object " & oProduct.Name & " is not a Part.", vbCritical, "Selection"
			Else
				
 				iNumberBodies = MechPart.Bodies.Count
  				For j = 1 to iNumberBodies
  	 				Set Body = MechPart.Bodies.Item(j)
 		 			oSelection.Add(Body)
 		 			Set oShapes = Body.Shapes
 		 			iNumberShapes = oShapes.Count
 		 			For k = 1 to iNumberShapes
 		 				Set oShape = oShapes.Item(k)
 		 				oSelection.Add(oShape)	
 		 			Next
 				Next
 			End If	
 	
  	Next
''--------------------------------------------
   ' change color 
  
	Set oVisProperties1 = oSelection.VisProperties
	oVisProperties1.SetVisibleColor r,g,b,0 

  	oSelection.Clear
  	oProductRoot.Update

End Sub

And finally, default CATIA color can be obtained also like this :

Code:
Language="VBSCRIPT"

Sub CATMain()

Dim productDocument1 As Document
Set productDocument1 = CATIA.ActiveDocument

Dim selection1 As Selection
Set selection1 = productDocument1.Selection

selection1.Search "CATPrtSearch.MechanicalFeature,all"

Set visPropertySet1 = selection1.VisProperties
visPropertySet1.SetRealColor 210,210,255,1

Set visProperties1 = CATIA.ActiveDocument.Selection.VisProperties
visProperties1.SetRealOpacity 255,1

selection1.Clear

selection1.Search "CATAsmSearch.Part,all"

Set visPropertySet1 = selection1.VisProperties
visPropertySet1.SetRealColor 210,210,255,1

Set visProperties1 = CATIA.ActiveDocument.Selection.VisProperties
visProperties1.SetRealOpacity 255,1

selection1.Clear

Dim specsAndGeomWindow1 As Window
Set specsAndGeomWindow1 = CATIA.ActiveWindow

Dim viewer3D1 As Viewer
Set viewer3D1 = specsAndGeomWindow1.ActiveViewer

viewer3D1.Reframe

Dim viewpoint3D1 As Viewpoint3D
Set viewpoint3D1 = viewer3D1.Viewpoint3D

End Sub





Regards
Fernando
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor