Code:
Option ExplicitSub CATMain()
CATIA.HSOSynchronized = False
CATIA.RefreshDisplay = False
Dim StartTime As Date
StartTime = Time
Dim oDocuments As Documents
Set oDocuments = CATIA.Documents
Dim oPartDocument, RGBDocument As Document
Set oPartDocument = CATIA.ActiveDocument
Dim AliasPart, oPart As Part
Set AliasPart = oPartDocument.Part
Dim AliasHybridBodies, oHybridBodies As HybridBodies
Set AliasHybridBodies = AliasPart.HybridBodies
Dim AliasHybridBody, oHybridBody, FarbeHybridBody As HybridBody
Set RGBDocument = oDocuments.Add("Part")
Set oPart = RGBDocument.Part
Set oHybridBodies = oPart.HybridBodies
Dim oSelection, RGBsel As Selection
Set RGBsel = RGBDocument.Selection
Dim oName As String
Dim r, g, b As Long
Dim i, j, k, l, m As Integer
Dim newLayerSet, newSet As Boolean
Dim oVisproperties As VisPropertySet
Dim oHybridShape As HybridShape
Set oHybridBody = oHybridBodies.Add()
oHybridBody.Name = AliasHybridBodies.Item(1).Name
'Loop for sorting Layer as Original_Layer and Color
For i = 1 To AliasHybridBodies.Count
newLayerSet = True
For j = 1 To oHybridBodies.Count
If AliasHybridBodies.Item(i).Name = oHybridBodies.Item(j).Name Then
Set oHybridBody = oHybridBodies.Item(j)
newLayerSet = False
End If
Next j
If newLayerSet = True Then
Set oHybridBody = oHybridBodies.Add()
oHybridBody.Name = AliasHybridBodies.Item(i).Name
End If
'Loop for each HybridShape of the Layer
For l = 1 To AliasHybridBodies.Item(i).HybridShapes.Count
Set oHybridShape = AliasHybridBodies.Item(i).HybridShapes.Item(l)
oPartDocument.Selection.Add oHybridShape
Set oSelection = oPartDocument.Selection
Set oVisproperties = oSelection.VisProperties
oSelection.VisProperties.GetRealColor r, g, b
oSelection.Copy
oSelection.Clear
oName = CStr(r) + " " + CStr(g) + " " + CStr(b)
newSet = True
If oHybridBody.HybridBodies.Count > 0 Then
For m = 1 To oHybridBody.HybridBodies.Count
If oHybridBody.HybridBodies.Item(m).Name = oName Then newSet = False
Next m
End If
If newSet = True Then
Set FarbeHybridBody = oHybridBody.HybridBodies.Add()
FarbeHybridBody.Name = r & " " & g & " " & b
RGBsel.Add FarbeHybridBody
RGBsel.PasteSpecial "CATPrtResultWithOutLink"
Else
RGBsel.Add oHybridBody.HybridBodies.Item(r & " " & g & " " & b)
RGBsel.PasteSpecial "CATPrtResultWithOutLink"
End If
RGBsel.Clear
Next l
Next i
CATIA.StartCommand ("collapse all")
oPart.Update
CATIA.HSOSynchronized = True
CATIA.RefreshDisplay = True
MsgBox "Total time: " & Format(Time - StartTime, "hh:mm:ss"), vbOKOnly
End Sub
Foren auf CAD.de (alle Foren)
| 
