找回密码
 立即注册

QQ登录

只需一步,快速开始

微信扫码登录

搜索
查看: 23|回复: 1

[分享] UG 装配体一键 随机改颜色

[复制链接]

1

主题

0

回帖

12

积分

列兵

积分
12
发表于 昨天 22:24 | 显示全部楼层 |阅读模式
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

1

主题

0

回帖

12

积分

列兵

积分
12
 楼主| 发表于 昨天 22:26 | 显示全部楼层
另存为   .vb文件,即可在ug中运行该宏程序
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

咨询QQ:1359218528|发帖须知!|Archiver|手机版|UG爱好者论坛 ( 京ICP备10217105号-2 )

GMT+8, 2026-7-22 02:00

Powered by Discuz! X3.5 Licensed

© 2001-2025 Discuz! Team.

快速回复 返回顶部 返回列表