学习社区 › SolidWorks二次开发（宏，VBA） › 求宏，在装配体下所有透明零件改不透明

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

活到老学到老！

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

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

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

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

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

楼主好人楼主好人

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

楼主很专业，写得很好！

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

好东西，努力学习学习！

查看完整版本: 求宏，在装配体下所有透明零件改不透明