求宏，在装配体下所有透明零件改不透明

junzz · 发表于 2023-8-19 17:08:53

经典图书

看一下有什么解决的方式

懒懒的高贵 · 发表于 2023-8-19 17:40:13

找到一段宏，但我试了没反应，有没有大神看看哪里的问题

Option Explicit
Dim swApp As SldWorks.SldWorks
Dim Part As ModelDoc2
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Dim cmd As String
Dim swComs As Variant
Dim swAsm As AssemblyDoc
Dim i As Integer
Dim swComp As Component2
Dim vcompfs As Variant
Dim vswtrans As Variant
Sub main()
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
If Part Is Nothing Then
MsgBox ("当前没有文件！")
Exit Sub
End If
If Part.GetType <> 2 Then
MsgBox ("当前文件不是装配体文件！")
Exit Sub
End If
Set swAsm = Part
swComs = swAsm.GetComponents(False)
'将所有透明零件返回不透明
Part.ClearSelection2 True
If Not IsEmpty(swComs) Then
For i = 0 To UBound(swComs)
Set swComp = swComs(i)
vswtrans = swComp.GetMaterialPropertyValues2(1, vcompfs)
If vswtrans(7) = 0.75 Then
boolstatus = Part.Extension.SelectByID2(swComp.Name2, "COMPONENT", 0, 0, 0, True, 0, Nothing, 0)
End If
Next i
End If
boolstatus = Part.SetComponentTransparent(False)
Part.ClearSelection2 True
End Sub

复制代码

zxt0824 · 发表于 2023-8-19 19:12:48

经典图书

感谢楼主分享，很不错！

wangchieh · 发表于 2023-8-23 19:56:25

看看是什么方法

zxw810604 · 发表于 2023-8-25 16:32:51

经典案例图书

谢谢楼主的分享，厉害克拉斯

xieguiming1982 · 发表于 2023-8-29 23:11:34

楼主很专业，写得很好！

xieguiming1982 · 发表于 2023-8-29 23:16:59

经典案例图书

xieguiming1982 发表于 2023-8-29 23:11
楼主很专业，写得很好！

Option Explicit

Dim swApp As SldWorks.SldWorks
Dim Part As ModelDoc2
Dim boolstatus As Boolean
Dim swComs As Variant
Dim swAsm As AssemblyDoc
Dim i As Integer
Dim swComp As Component2
Dim vcompfs As Variant
Dim vswtrans As Variant

Sub main()
Set swApp = Application.SldWorks

Set Part = swApp.ActiveDoc
If Part Is Nothing Then
      MsgBox ("当前没有文件！")
      Exit Sub
End If

If Part.GetType <> swDocumentTypes_e.swDocASSEMBLY Then
      MsgBox ("当前文件不是装配体文件！")
      Exit Sub
End If

Set swAsm = Part
swComs = swAsm.GetComponents(False)

'将所有透明零件设为不透明
Part.ClearSelection2 True

If Not IsEmpty(swComs) Then
      For i = 0 To UBound(swComs)
         Set swComp = swComs(i)
         vswtrans = swComp.GetMaterialPropertyValues2(1, vcompfs)

         If vswtrans(7) = 0.75 Then
            boolstatus = Part.Extension.SelectByID2(swComp.Name2, "COMPONENT", 0, 0, 0, True, 0, Nothing, 0)
         End If
      Next i
End If

boolstatus = Part.SetComponentTransparent(False)
Part.ClearSelection2 True
End Sub

xieguiming1982 · 发表于 2023-8-29 23:17:38

Option Explicit
Dim swApp As SldWorks.SldWorks
Dim Part As ModelDoc2
Dim boolstatus As Boolean
Dim swComs As Variant
Dim swAsm As AssemblyDoc
Dim i As Integer
Dim swComp As Component2
Dim vcompfs As Variant
Dim vswtrans As Variant
Sub main()
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
If Part Is Nothing Then
MsgBox ("当前没有文件！")
Exit Sub
End If
If Part.GetType <> swDocumentTypes_e.swDocASSEMBLY Then
MsgBox ("当前文件不是装配体文件！")
Exit Sub
End If
Set swAsm = Part
swComs = swAsm.GetComponents(False)
'将所有透明零件设为不透明
Part.ClearSelection2 True
If Not IsEmpty(swComs) Then
For i = 0 To UBound(swComs)
Set swComp = swComs(i)
vswtrans = swComp.GetMaterialPropertyValues2(1, vcompfs)
If vswtrans(7) = 0.75 Then
boolstatus = Part.Extension.SelectByID2(swComp.Name2, "COMPONENT", 0, 0, 0, True, 0, Nothing, 0)
End If
Next i
End If
boolstatus = Part.SetComponentTransparent(False)
Part.ClearSelection2 True
End Sub

复制代码

xieguiming1982 · 发表于 2023-8-29 23:19:44

将所有透明零件设为不透明

jyzas001 · 发表于 2023-8-30 08:50:02

经典图书

学习一下

Jadezhao · 发表于 2023-8-31 08:15:40

谢谢分享！

懒懒的高贵 · 发表于 2023-9-1 09:43:26

xieguiming1982 发表于 2023-8-29 23:17

运行了下还是不行，没有反应

10086b · 发表于 2023-9-4 09:40:43

康康，是不是好方法

xiedd126 · 发表于 2023-9-7 14:28:12

看看！！！

XBCYANP · 发表于 2023-9-27 18:14:58

加入QQ群
参与讨论和学习

或扫描二维码加入

活到老学到老！

doszmw · 发表于 2023-10-9 08:53:17

经典案例图书

SW机械工程师网，找到组织了！

doszmw · 发表于 2023-10-9 08:54:45

加入QQ群
参与讨论和学习

或扫描二维码加入

很不错，顶一下！很不错，顶一下！

qq837828724 · 发表于 2023-10-19 11:45:14

经典案例图书

楼主好人楼主好人

pjhzdq · 发表于 2023-10-25 16:52:46

楼主很专业，写得很好！

hdgd501 · 发表于 2023-10-26 08:03:33

好东西，努力学习学习！

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

求宏，在装配体下所有透明零件改不透明

最佳新人

活跃会员

热心会员

宣传达人

灌水之王

突出贡献