最近在网上浏览：看到介绍“SolidWorks装配体随机颜色宏

淡淡的雲 · 发表于 2024-3-21 10:18:02

经典图书

最近在网上浏览：看到介绍“SolidWorks装配体随机颜色宏就是那种一键上色的功能，哪位朋友能不能分享一下

wyzhangbin · 发表于 2024-9-24 14:58:01

Dim swApp As Object
Sub main()

Set swApp = Application.SldWorks
Dim ModelDoc As Object
swApp.Visible = True
Set ModelDoc = swApp.ActiveDoc
Dim htMaterialPorpertyValues
Dim selmgr
Dim n
Dim i
Dim htcomponent
If ModelDoc.GetType() = 1 Then '当前激活的是零件
htMaterialPorpertyValues = ModelDoc.MaterialPropertyValues
SetColor ModelDoc
ElseIf ModelDoc.GetType() = 2 Then '当前激活的是组件

Set selmgr = ModelDoc.SelectionManager
n = selmgr.GetSelectedObjectCount
For i = 1 To n
Set htcomponent = selmgr.GetSelectedObjectsComponent(i)
TraverseComponent htcomponent
Next
End If

ModelDoc.WindowRedraw
ModelDoc.ClearSelection2 True

End Sub

Sub SetColor(htPart)
On Error Resume Next
' htPart.RemoveMaterialProperty
Dim htMaterialPorpertyValues
Dim strdisplayState
'strdisplayState = htPart.displayState
'htPart.RemoveTextureByDisplayState (strdisplayState)
htMaterialPorpertyValues = htPart.MaterialPropertyValues
Randomize
htMaterialPorpertyValues(0) = Rnd
htMaterialPorpertyValues(1) = Rnd
htMaterialPorpertyValues(2) = Rnd
htPart.MaterialPropertyValues = htMaterialPorpertyValues
On Error GoTo 0
End Sub
Function TraverseComponent(htcomponent)
Dim children
Dim ChildCount
Dim j
Dim child
Dim htMaterialPorpertyValues
Dim htPart

If Not htcomponent Is Nothing Then
' Debug.Print htcomponent.Name

children = htcomponent.GetChildren
If UBound(children) > 0 Then
ChildCount = UBound(children) + 1

For j = 0 To ChildCount - 1
Set child = children(j)
'Debug.Print child.Name
'SetColor child.GetModelDoc
TraverseComponent child
Next
Else
If Not htcomponent Is Nothing Then
Debug.Print htcomponent.Name
htMaterialPorpertyValues = htcomponent.MaterialPropertyValues

If TypeName(htMaterialPorpertyValues) = "Empty" Then
Set htPart = htcomponent.GetModelDoc
SetColor htPart
Else
SetColor htcomponent
'htcomponent.EditRebuild
End If
End If
End If
End If
End Function

沉默的人 · 发表于 2024-3-21 10:50:02

经典图书

很不错，顶一下！

淡淡的雲 · 发表于 2024-3-21 15:14:58

顶一下，坐等高手！

sunsu168 · 发表于 2024-9-25 07:43:16

经典案例图书

论坛搜索下，很多

董东咚 · 发表于 2024-9-25 10:36:09

活到老学到老！

叶落满空山 · 发表于 2024-9-25 11:35:27

经典案例图书

论坛有很多了，自己常用的发上来几个，图片上对应的是“多实体随机颜色Random Color”

叶落满空山 · 发表于 2024-9-27 09:00:33

叶落满空山发表于 2024-9-25 11:35
论坛有很多了，自己常用的发上来几个，图片上对应的是“多实体随机颜色Random Color”

这个里面还少一个拾取颜色再着色的宏，曾经在论坛里看到了，但是现在不知道怎么找了

liyuyin007 · 发表于 2024-9-27 13:34:17

楼主太有才了，膜拜中……

若似天意 · 发表于 2024-12-5 11:10:24

经典图书

感谢感谢感谢感谢感谢感谢

sunny_8848 · 发表于 2024-12-5 12:44:16

楼主太有才了，膜拜中……

风雨阳光 · 发表于 2024-12-24 17:03:39

SolidWorks机械工程师网，顶一下。

leadlead009 · 发表于 2024-12-26 22:27:31

活到老学到老！

leadlead009 · 发表于 2024-12-27 22:49:53

SolidWorks机械工程师网，顶一下。

八八牛 · 发表于 2025-2-26 22:34:30

加入QQ群
参与讨论和学习

或扫描二维码加入

wyzhangbin 发表于 2024-9-24 14:58
Dim swApp As Object
Sub main()

棒极了

运行它就可以改变立即颜色

八八牛 · 发表于 2025-2-26 22:59:54

经典案例图书

wyzhangbin 发表于 2024-9-24 14:58
Dim swApp As Object
Sub main()

有一个问题，就是多实体零件的每个零件改变的颜色都相同，不是改成各自不同的颜色。能优化下吗？

yun6yun7 · 发表于 2025-4-10 23:56:48

加入QQ群
参与讨论和学习

或扫描二维码加入

感谢楼主分享，很不错！

qxb2008 · 发表于 2025-4-15 16:05:21

经典案例图书

感谢分享，很不错

葛特曼 · 发表于 2025-4-15 20:28:30

很不错，顶一下！

zhaixinlu · 发表于 2025-5-5 10:08:33

SolidWorks机械工程师网，顶一下

		自动登录	找回密码
密码			立即注册

最近在网上浏览：看到介绍“SolidWorks装配体随机颜色宏

浏览过的版块

最佳新人

活跃会员

热心会员

宣传达人

灌水之王

突出贡献