分享个五彩缤纷宏

xieguiming113

Sub main()

Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swElement As Object
Dim vElementArr As Variant
Dim vElement As Variant
Dim vMatProp As Variant

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
vMatProp = swModel.MaterialPropertyValues

'Get all elements
If swModel.GetType = swDocPART Then
vElementArr = swModel.GetBodies2(swAllBodies, False)

For Each vElement In vElementArr
Set swElement = vElement
Randomize
vMatProp(0) = Rnd 'Red
vMatProp(1) = Rnd 'Green
vMatProp(2) = Rnd 'Blue
vMatProp(3) = Rnd / 2 + 0.5 'Ambient
vMatProp(4) = Rnd / 2 + 0.5 'Diffuse
vMatProp(5) = Rnd 'Specular
vMatProp(6) = Rnd * 0.9 + 0.1 'Shininess
swElement.MaterialPropertyValues2 = vMatProp
Next

ElseIf swModel.GetType = swDocASSEMBLY Then
vElementArr = swModel.GetComponents(False)

For Each vElement In vElementArr
Set swElement = vElement
Randomize
vMatProp(0) = Rnd 'Red
vMatProp(1) = Rnd 'Green
vMatProp(2) = Rnd 'Blue
vMatProp(3) = Rnd / 2 + 0.5 'Ambient
vMatProp(4) = Rnd / 2 + 0.5 'Diffuse
vMatProp(5) = Rnd 'Specular
vMatProp(6) = Rnd * 0.9 + 0.1 'Shininess
swElement.MaterialPropertyValues = vMatProp
Next

ElseIf swModel.GetType = swDocDRAWING Then
MsgBox ("You can only apply random colors to part bodies or assembly components.")
Exit Sub

End If

'Redraw to see new color
swModel.GraphicsRedraw2

End Sub

xiaocake

为嘛没人回帖，这就是随机上色宏啊

judyyai

xiaocake 發表於 2018/7/15 16:10
为嘛没人回帖，这就是随机上色宏啊

可以加上 [  code  ] 內容 [  /code  ] 分別
正確語法是沒有空格的!
   

xiaocake

judyyai 發表於 2018/7/15 17:33
可以加上 [  code  ] 內容 [  /code  ] 分別
正確語法是沒有空格的!

这不是我写的代码，不管代码是否有误，至少得感谢一下人家呀

judyyai

xiaocake 發表於 2018/7/15 18:07
这不是我写的代码，不管代码是否有误，至少得感谢一下人家呀

突然發現~
是我眼拙~看成5個宏(巨集)

原來是指 此宏 名為"五彩繽紛"
以為是5個宏，想說沒分開 不知道如何擷取~

謝謝分享~但是不知道此宏(巨集)用處如何,我只會用不會寫宏，不知道如何討論
PS.今天第一次看到此篇文章!(測試如下)

xiaocake

judyyai 發表於 2018/7/15 19:33
突然發現~
是我眼拙~看成5個宏(巨集)

我也是今天才看到,我也有写过这个功能，处理思想跟这个差不多，
但比这个完善点:相同零部件是相同颜色。
这个代码不管是否是同一个零部件，都是随机的颜色。
这个宏的用处就是给当前模型（零件或装配体）指定随机的颜色
如果是零件就随机分配一个颜色；如果是装配体的话给装配体中每个元件随机分配个颜色。
用法：打开零件或装配体后，执行此宏(巨集)使用效果截图如下：

judyyai

xiaocake 發表於 2018/7/15 20:11
我也是今天才看到,我也有写过这个功能，处理思想跟这个差不多，
但比这个完善点:相同零部件是相同颜色。
...

原來用法是這樣!
這樣很方便
不用一個一個去指定~
謝謝分享指導!上面你說

有写过这个功能，处理思想跟这个差不多，
但比这个完善点:相同零部件是相同颜色。

剛剛!突然想起~悶人 之前也有一個巨集

原本沒上色的組合


用此宏，上色後(相同零件 有不一樣顏色)


用了悶人的宏(相同零件 是一樣的顏色)




悶人自動上色宏-傳送們

chaomogu

judyyai 發表於 2018/7/15 20:15
原來用法是這樣!
這樣很方便
不用一個一個去指定~

能否告知那个网站需要用什么邮箱注册，注册不了。

judyyai

chaomogu 發表於 2018/7/19 15:05
能否告知那个网站需要用什么邮箱注册，注册不了。

點一下註冊就有明細會跟你說了~

chaomogu

judyyai 發表於 2018/7/21 21:45
點一下註冊就有明細會跟你說了~

确实注册不了，难道是关闭注册了？

xieguiming113

焊接件里用这个宏就不一样效果了

wutong490

修改一处代码就可以使相同零件相同颜色。（道理还不懂）
Set swElement = vElement.GetModelDoc


有个不足的地方就是 ，不同配置的零部件只能更改最先插入的。