SolidWorks机械工程师网——最大的SolidWorks学习平台

标题: 求 隐藏草图 宏 [打印本页]
作者: 阿斯蒂芬0    时间: 2021-8-26 00:04
标题: 求 隐藏草图 宏
一键隐藏 显示 顶层装配体 子装配体下所有零件（零件中插入的零件）中的草图                      装配体或者零件环境下都能用最好



作者: fan03488    时间: 2021-8-26 11:45
顶一下，坐等高手！
作者: design100    时间: 2021-8-26 13:30
Option Explicit
Sub BlankSketchFeature(swApp As SldWorks.SldWorks, swModel As SldWorks.ModelDoc2, swFeat As SldWorks.Feature)
    Dim bRet  As Boolean
    If "ProfileFeature" = swFeat.GetTypeName Then
        bRet = swFeat.Select2(False, 0): Debug.Assert bRet
        swModel.BlankSketch '隐藏草图
    End If
End Sub

Sub TraverseFeatureFeatures(swApp As SldWorks.SldWorks, swModel As SldWorks.ModelDoc2, swFeat As SldWorks.Feature, nLevel As Long)
    Dim swSubFeat As SldWorks.Feature
    Dim swSubSubFeat As SldWorks.Feature
    Dim swSubSubSubFeat As SldWorks.Feature
    Dim sPadStr As String
    Dim i As Long
    For i = 0 To nLevel
        sPadStr = sPadStr + "  "
    Next i
    Dim bRet As Boolean
    If "Annotations" <> swFeat.Name Then
        bRet = swFeat.Select2(True, 0): Debug.Assert bRet
    End If
    While Not swFeat Is Nothing
        Debug.Print sPadStr + swFeat.Name + " [" + swFeat.GetTypeName + "]"
        BlankSketchFeature swApp, swModel, swFeat
        Set swSubFeat = swFeat.GetFirstSubFeature
        While Not swSubFeat Is Nothing
            Debug.Print sPadStr + "  " + swSubFeat.Name + " [" + swSubFeat.GetTypeName + "]"
            BlankSketchFeature swApp, swModel, swSubFeat
            Set swSubSubFeat = swSubFeat.GetFirstSubFeature
            While Not swSubSubFeat Is Nothing
                Debug.Print sPadStr + "    " + swSubSubFeat.Name + " [" + swSubSubFeat.GetTypeName + "]"
                BlankSketchFeature swApp, swModel, swSubSubFeat
                Set swSubSubSubFeat = swSubFeat.GetFirstSubFeature
                While Not swSubSubSubFeat Is Nothing
                    Debug.Print sPadStr + "      " + swSubSubSubFeat.Name + " [" + swSubSubSubFeat.GetTypeName + "]"
                    BlankSketchFeature swApp, swModel, swSubSubSubFeat
                    Set swSubSubSubFeat = swSubSubSubFeat.GetNextSubFeature()
                Wend
                Set swSubSubFeat = swSubSubFeat.GetNextSubFeature()
            Wend
            Set swSubFeat = swSubFeat.GetNextSubFeature()
        Wend
        Set swFeat = swFeat.GetNextFeature
    Wend
End Sub

Sub TraverseComponentFeatures(swApp As SldWorks.SldWorks, swModel As SldWorks.ModelDoc2, swComp As SldWorks.Component2, nLevel As Long)
    Dim swFeat As SldWorks.Feature

    Set swFeat = swComp.FirstFeature
    TraverseFeatureFeatures swApp, swModel, swFeat, nLevel
End Sub

Sub TraverseComponent(swApp As SldWorks.SldWorks, swModel As SldWorks.ModelDoc2, swComp As SldWorks.Component2, nLevel As Long)
    Dim vChildComp As Variant
    Dim swChildComp As SldWorks.Component2
    Dim swCompConfig As SldWorks.Configuration
    Dim sPadStr As String
    Dim i As Long
    For i = 0 To nLevel - 1
        sPadStr = sPadStr + "  "
    Next i
    vChildComp = swComp.GetChildren
    For i = 0 To UBound(vChildComp)
        Set swChildComp = vChildComp(i)
        Debug.Print sPadStr & "+" & swChildComp.Name2 & " <" & swChildComp.ReferencedConfiguration & ">"
        TraverseComponentFeatures swApp, swModel, swChildComp, nLevel
        TraverseComponent swApp, swModel, swChildComp, nLevel + 1
    Next i
End Sub

Sub TraverseModelFeatures(swApp As SldWorks.SldWorks, swModel As SldWorks.ModelDoc2, nLevel As Long)
    Dim swFeat As SldWorks.Feature

    Set swFeat = swModel.FirstFeature
    TraverseFeatureFeatures swApp, swModel, swFeat, nLevel
End Sub
Sub main()
    Dim swApp As SldWorks.SldWorks
    Dim swModel As SldWorks.ModelDoc2
    Dim swConf As SldWorks.Configuration
    Dim swRootComp As SldWorks.Component2
    Dim nStart As Long
    Dim bRet As Boolean

    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swConf = swModel.GetActiveConfiguration
    Set swRootComp = swConf.GetRootComponent3(True)
    nStart = Timer


    TraverseModelFeatures swApp, swModel, 1 '零件
   
    TraverseComponent swApp, swModel, swRootComp, 1 '装配体

End Sub

作者: 阿斯蒂芬0    时间: 2021-8-26 16:11
复制到这里不能运行

For i = 0 To UBound(vChildComp) 类型不匹配
作者: design100    时间: 2021-8-27 08:39
这个用VBA式试

Macro1.rar

（10.43 KB, 下载次数: 239 ）

作者: 阿斯蒂芬0    时间: 2021-8-27 14:22
可以运行，零件环境下挺好的   装配体环境下 20个零件就 运行太慢很容易卡死 必须点这里的运行才能使用

作者: yolandaliu    时间: 2021-8-27 16:43
很不错，顶一下！
作者: design100    时间: 2021-8-28 08:46
阿斯蒂芬0 发表于 2021-8-27 14:22
可以运行，零件环境下挺好的   装配体环境下 20个零件就 运行太慢很容易卡死 必须点这里的运行才能使用

我试过50多个零件下的速度还行.

可能电脑配制上的差异吧!

只能帮你到这
作者: 阿斯蒂芬0    时间: 2021-8-28 17:22
design100 发表于 2021-8-28 08:46
我试过50多个零件下的速度还行.

可能电脑配制上的差异吧!

谢谢大佬                     
作者: 阿斯蒂芬0    时间: 2021-9-2 20:57
SW机械工程师网，找到组织了！
作者: qqfly332211    时间: 2021-9-10 13:17
好东西，努力学习学习！
作者: 阿斯蒂芬0    时间: 2021-9-10 21:46
好好学习，天天向上！
作者: qqfly332211    时间: 2021-9-14 22:39
好好学习，天天向上！
作者: 阿斯蒂芬0    时间: 2021-9-23 21:42
活到老学到老！
作者: fz8889    时间: 2021-11-1 11:21
活到老学到老！
作者: fan03488    时间: 2021-11-2 19:31
好东西，努力学习学习！
作者: fz8889    时间: 2021-11-3 10:53
活到老学到老！
作者: 2210953427    时间: 2023-12-4 08:49
好东西，努力学习学习！
作者: samsun288    时间: 2023-12-8 19:59
下载下来看看，应该会有用！
作者: samsun288    时间: 2023-12-10 18:04
为什么不能直接运行，要用调试--运行才行
作者: 小灬白灬菜    时间: 2024-3-20 17:12
我这个应该是你想的那种

遍历隐藏草图.rar

（14.49 KB, 下载次数: 7 售价: 10 金币 ）

作者: princeandeneral    时间: 2024-3-20 20:22
可以使用，就是不能 直接运行，需要调试运行才行，有大神修改么
作者: zwp0422    时间: 2024-4-17 17:30
遇到高手了，学习了



欢迎光临 SolidWorks机械工程师网——最大的SolidWorks学习平台 (https://www.swbbsc.com/) Powered by Discuz! X3.2