求教大神两个录制的宏怎么合成一个

烟雾缭绕fengzi

   经典图书

我想为SOLIDWORKS钣金的平板形式定制一个快捷键，分别录制了解压平板形式和压缩平板形式两个宏，两个宏作为两个快捷键，这样钣金展开和折叠要使用两个快捷键，我想一键就实现展开和压缩，但不会合并这两段宏，求大神帮忙。下面是两个宏：
Sub main()
Set swApp = _
Application.SldWorks
Set Part = swApp.ActiveDoc
boolstatus = Part.Extension.SelectByID2("平板型式11", "BODYFEATURE", 0, 0, 0, False, 0, Nothing, 0)
Part.EditSuppress2
boolstatus = Part.Extension.SelectByID2("平板型式", "BODYFEATURE", 0, 0, 0, False, 0, Nothing, 0)
Part.ClearSelection2 True
End Sub
Sub main()
Set swApp = _
Application.SldWorks
Set Part = swApp.ActiveDoc
boolstatus = Part.Extension.SelectByID2("平板型式", "BODYFEATURE", 0, 0, 0, False, 0, Nothing, 0)
boolstatus = Part.Extension.SelectByID2("平板型式", "BODYFEATURE", 0, 0, 0, False, 0, Nothing, 0)
Part.ClearSelection2 True
boolstatus = Part.Extension.SelectByID2("平板型式11", "BODYFEATURE", 0, 0, 0, False, 0, Nothing, 0)
Part.EditUnsuppress2
boolstatus = Part.Extension.SelectByID2("平板型式", "BODYFEATURE", 0, 0, 0, False, 0, Nothing, 0)
Part.ClearSelection2 True
End Sub

#1oo=#1oo一1

试试这个,如用繁体要改名称

Dim swApp As Object
Dim part As Object
Dim boolstatus As Boolean
Dim swSelMgr  As SldWorks.SelectionMgr
Dim swFeat    As SldWorks.Feature
Dim vConfNameArr  As Variant
Dim vSuppStateArr  As Variant
Dim i As Integer
Sub main()
Set swApp = Application.SldWorks
Set part = swApp.ActiveDoc
boolstatus = part.Extension.SelectByID2("平板型式1", "BODYFEATURE", 0, 0, 0, False, 0, Nothing, 0)
  
  Set swSelMgr = part.SelectionManager
  Set swFeat = swSelMgr.GetSelectedObject6(1, -1)
   vConfNameArr = part.GetConfigurationNames
    vSuppStateArr = swFeat.IsSuppressed2(swThisConfiguration, vConfNameArr)
  Debug.Assert 0 = UBound(vSuppStateArr)
   
   vSuppStateArr = swFeat.IsSuppressed2(swAllConfiguration, vConfNameArr)
Debug.Assert UBound(vSuppStateArr) = UBound(vConfNameArr)
   
vSuppStateArr = swFeat.IsSuppressed2(swSpecifyConfiguration, vConfNameArr)
Debug.Assert UBound(vSuppStateArr) = UBound(vConfNameArr)
For i = 0 To UBound(vConfNameArr)
        Debug.Print "    " & vConfNameArr(i) & " ---> " & vSuppStateArr(i)
    If (vSuppStateArr(i) = False) Then
    part.EditSuppress

     ElseIf (vSuppStateArr(i) = True) Then
     part.EditUnsuppress
    End If
Next i
part.ClearSelection2 True
End Sub

复制代码

jxb123456

   经典图书

运行后26行出错

12334D

"平板型式"名称不一致造成的

砰砰

   经典案例图书

Dim swApp As Object
Dim part As Object
Dim boolstatus As Boolean
Dim swSelMgr  As SldWorks.SelectionMgr
Dim swFeat    As SldWorks.Feature
Dim vConfNameArr  As Variant
Dim vSuppStateArr  As Variant
Dim i As Integer
Dim ii As Integer
Dim nn As Integer
Sub main()
Set swApp = Application.SldWorks
Set part = swApp.ActiveDoc
With part
nn = .FeatureManager.GetFeatureCount(True)
Set swFeat = .FirstFeature
Debug.Print swFeat.GetTypeName
For ii = 1 To nn - 1
Set swFeat = swFeat.GetNextFeature
Debug.Print swFeat.GetTypeName, swFeat.Name
If swFeat.GetTypeName = FlatPattern Then Exit For
Next ii
End With
boolstatus = part.Extension.SelectByID2(swFeat.Name, "BODYFEATURE", 0, 0, 0, False, 0, Nothing, 0)    '选择平板型式特征
  Set swSelMgr = part.SelectionManager
  Set swFeat = swSelMgr.GetSelectedObject6(1, -1)
   vConfNameArr = part.GetConfigurationNames
   vSuppStateArr = swFeat.IsSuppressed2(swThisConfiguration, vConfNameArr)
  Debug.Assert 0 = UBound(vSuppStateArr)
   
   vSuppStateArr = swFeat.IsSuppressed2(swAllConfiguration, vConfNameArr)
    Debug.Assert UBound(vSuppStateArr) = UBound(vConfNameArr)
   
vSuppStateArr = swFeat.IsSuppressed2(swSpecifyConfiguration, vConfNameArr)
Debug.Assert UBound(vSuppStateArr) = UBound(vConfNameArr)
For i = 0 To UBound(vConfNameArr)
    Debug.Print "    " & vConfNameArr(i) & " ---> " & vSuppStateArr(i)
    If (vSuppStateArr(i) = False) Then
    part.EditSuppress
    ElseIf (vSuppStateArr(i) = True) Then
    part.EditUnsuppress
    End If
Next i
part.ClearSelection2 True
End Sub

复制代码

梦醒丶莫言情ㄣ

学习一下

幽冥之殇

   经典案例图书

试了一下，展开没问题，但是有些钣金零件折叠不回去，这是为什么？

@旭@

上part 看下

lichun761014

做了一个简单的钣金件，试了一下五楼的宏代码，运行没问题。
谢谢pyczt大大共享源代码。