UG 装配体一键 随机改颜色
UG 装配体一键 随机改颜色的插件Option Strict Off
Imports System
Imports System.Collections.Generic
Imports NXOpen
Module RandomColorAssembly
Dim theSession As Session = Session.GetSession()
Dim partColorDict As New Dictionary(Of String, Integer)(StringComparer.OrdinalIgnoreCase)
Dim partBodyColored As New Dictionary(Of String, Boolean)(StringComparer.OrdinalIgnoreCase)
Dim rand As New Random()
Sub Main()
Dim workPart As Part = theSession.Parts.Work
If workPart Is Nothing Then
Return
End If
' 先完全加载当前工作部件（装配体则连同其下所有组件一并加载），避免后续 "Part is only partially loaded"
Dim loadStatus As PartLoadStatus = Nothing
Try
loadStatus = workPart.LoadFully()
If loadStatus IsNot Nothing Then loadStatus.Dispose()
Catch ex As Exception
End Try
' 如果是装配体，递归遍历组件；否则按单零件处理
Dim rootComp As Assemblies.Component = Nothing
Try
If workPart.ComponentAssembly IsNot Nothing AndAlso workPart.ComponentAssembly.RootComponent IsNot Nothing Then
rootComp = workPart.ComponentAssembly.RootComponent
End If
Catch ex As NXException
' 装配仅部分加载时 RootComponent 可能抛 "Part is only partially loaded"
rootComp = Nothing
End Try
If rootComp IsNot Nothing Then
partColorDict.Clear()
partBodyColored.Clear()
ColorComponentsRecursively(rootComp, rootComp)
Else
ColorSinglePart(workPart)
End If
End Sub
' 安全获取组件的 OwningPart，遇“仅部分加载”等异常时返回 Nothing
Function TryGetPartFromComponent(ByVal comp As Assemblies.Component) As Part
If comp Is Nothing Then Return Nothing
Try
If comp.Prototype Is Nothing Then Return Nothing
Dim p As Part = comp.Prototype.OwningPart
Return p
Catch ex As NXException
Return Nothing
Catch ex As Exception
Return Nothing
End Try
End Function
Sub ColorComponentsRecursively(ByVal comp As Assemblies.Component, ByVal rootComp As Assemblies.Component)
If comp Is Nothing Then Return
If IsLeafComponent(comp) Then
Dim part As Part = TryGetPartFromComponent(comp)
If part IsNot Nothing Then
Dim colorIndex As Integer = GetOrCreateColorForPart(part)
Try
' 装配中：先改组件显示
ApplyColorToComponent(comp, colorIndex)
Catch ex As Exception
End Try
' 临时切到该零件为工作部件，给本体上色并保存，这样单独打开时才有颜色（每零件只做一次）
Dim key As String = part.Leaf
If Not partBodyColored.ContainsKey(key) Then
Try
Dim partLoadStatus As PartLoadStatus = Nothing
theSession.Parts.SetWorkComponent(comp, PartCollection.RefsetOption.Entire, PartCollection.WorkComponentOption.Visible, partLoadStatus)
Dim partAsWork As Part = theSession.Parts.Work
If partAsWork IsNot Nothing Then
ApplyColorToPartBodies(partAsWork, colorIndex)
partAsWork.Save(BasePart.SaveComponents.True, BasePart.CloseAfterSave.False)
End If
partBodyColored(key) = True
Catch ex As Exception
Finally
' 切回装配为工作部件
Try
Dim partLoadStatusBack As PartLoadStatus = Nothing
theSession.Parts.SetWorkComponent(rootComp, PartCollection.RefsetOption.Entire, PartCollection.WorkComponentOption.Visible, partLoadStatusBack)
Catch ex2 As Exception
End Try
End Try
End If
End If
End If
' 仅部分加载的组件 GetChildren 可能抛 NXException，需捕获后跳过子级
Try
For Each child As Assemblies.Component In comp.GetChildren()
ColorComponentsRecursively(child, rootComp)
Next
Catch ex As NXException
' 部分加载时跳过该分支的子组件
Catch ex As Exception
End Try
End Sub
Sub ColorSinglePart(ByVal part As Part)
If part Is Nothing Then Return
Dim colorIndex As Integer = GetOrCreateColorForPart(part)
Try
ApplyColorToPartBodies(part, colorIndex)
part.Save(BasePart.SaveComponents.True, BasePart.CloseAfterSave.False)
Catch ex As Exception
End Try
End Sub
Function GetOrCreateColorForPart(ByVal part As Part) As Integer
If part Is Nothing Then Return 0
Dim key As String = part.Leaf
Dim colorIndex As Integer
' 先看内存中是否已经有该零件名的颜色
If partColorDict.TryGetValue(key, colorIndex) Then
Return colorIndex
End If
' 再尝试从零件属性中读取
Dim attrColor As Integer = GetColorFromAttribute(part)
If attrColor > 0 Then
colorIndex = attrColor
Else
colorIndex = rand.Next(1, 217)
End If
' 写入字典和零件属性
partColorDict(key) = colorIndex
SaveColorToAttribute(part, colorIndex)
Return colorIndex
End Function
Function GetColorFromAttribute(ByVal part As Part) As Integer
Try
Dim nxObj As NXObject = CType(part, NXObject)
' 优先使用 HasUserAttribute / GetIntegerUserAttribute，兼容性更好
If nxObj.HasUserAttribute("RandomColorIndex", NXObject.AttributeType.Integer, -1) Then
Dim val As Integer = nxObj.GetIntegerUserAttribute("RandomColorIndex", -1)
Return val
End If
Catch ex As Exception
End Try
Return -1
End Function
Sub SaveColorToAttribute(ByVal part As Part, ByVal colorIndex As Integer)
Try
Dim nxObj As NXObject = CType(part, NXObject)
' 第 2 个参数是属性索引，任意固定整数即可
nxObj.SetUserAttribute("RandomColorIndex", 1, colorIndex, Update.Option.Now)
Catch ex As Exception
End Try
End Sub
Sub ApplyColorToComponent(ByVal comp As Assemblies.Component, ByVal colorIndex As Integer)
If comp Is Nothing Then Return
Dim displayMod As DisplayModification = Nothing
Try
displayMod = theSession.DisplayManager.NewDisplayModification()
displayMod.NewColor = colorIndex
displayMod.ApplyToAllFaces = True
displayMod.Apply(New DisplayableObject() {comp})
Finally
If displayMod IsNot Nothing Then
displayMod.Dispose()
End If
End Try
End Sub
Sub ApplyColorToPartBodies(ByVal part As Part, ByVal colorIndex As Integer)
If part Is Nothing Then Return
Dim bodies() As Body = part.Bodies.ToArray()
If bodies Is Nothing OrElse bodies.Length = 0 Then Return
Dim objs(bodies.Length - 1) As DisplayableObject
For i As Integer = 0 To bodies.Length - 1
objs(i) = bodies(i)
Next
Dim displayMod As DisplayModification = Nothing
Try
displayMod = theSession.DisplayManager.NewDisplayModification()
displayMod.NewColor = colorIndex
displayMod.ApplyToAllFaces = True
' 颜色写入零件本体，单独打开时才能看到
displayMod.ApplyToOwningParts = True
displayMod.Apply(objs)
Finally
If displayMod IsNot Nothing Then
displayMod.Dispose()
End If
End Try
End Sub
' 叶子组件：对应的是零件文件（不是子装配），需要上色
Function IsLeafComponent(ByVal comp As Assemblies.Component) As Boolean
If comp Is Nothing Then Return False
Dim part As Part = TryGetPartFromComponent(comp)
If part Is Nothing Then Return False
' 子装配有 RootComponent，只给“零件”上色（访问 RootComponent 时部分加载会抛异常）
Try
If part.ComponentAssembly IsNot Nothing AndAlso part.ComponentAssembly.RootComponent IsNot Nothing Then
Return False
End If
Catch ex As NXException
' 部分加载时当作叶子组件处理，避免再次访问
Return True
Catch ex As Exception
Return True
End Try
Return True
End Function
Public Function GetUnloadOption(ByVal dummy As String) As Integer
Return Session.LibraryUnloadOption.Immediately
End Function
End Module
另存为 .vb文件，即可在ug中运行该宏程序 感谢分享，支持一下
页:
[1]