SW宏-删除所有配置属性

叶飘零

1. Dim swApp As Object
   
2. 
   $ W' l8 U, v6 @5 F) g+ W4 S4 K) b7 M
3. Dim Part As Object
   4 b# P& N+ y+ K3 {8 k! E
4. Dim boolstatus As Boolean
   + j; ]$ O  ?9 t  m5 i
5. Dim longstatus As Long, longwarnings As Long
   , U+ [+ b8 G! ~, z
6. 
   % _1 }% d/ K. F6 S
7. Sub main() '删除所有配置属性
   
8. 
   3 A/ C2 V% d/ e
9. Set swApp = Application.SldWorks
   
10. 
    ' u- M* r: R. F: `
11. Set Part = swApp.ActiveDoc
    
12. 
    0 j/ i! k8 z3 S+ H+ {2 J
13. CurCFGname = Part.GetConfigurationNames
    6 W" g1 q- [- ]. N( g, [/ u, e
14. 
    ; A$ p8 A. F# e9 a* L) d( T
15. CurCFGnameCount = Part.GetConfigurationCount
    / _8 T  r! G6 ?8 h# I
16. 
    5 Y0 S* B! c7 ~6 ~" |5 m& ]
17. For i = 0 To CurCFGnameCount - 1
    + i3 G$ Q' x) C; t( c9 c2 |5 n* J" n
18. 
    3 P9 h) i# h: A. K' D2 `
19.     Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
    . W/ T6 f% I% c+ S2 ]% }
20. 
    
21.     Vnamearr = CusPropMgr.GetNames
    
22. 
    1 E6 @9 u3 [" g# d! H. v. j7 u
23.     If Not IsEmpty(Vnamearr) Then
    
24. 
    7 {8 ]- u3 V9 a; m% q# M2 C! O7 ^& f
25.         For Each Vnamearr2 In Vnamearr
    
26. 
    
27.             bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
    
28. 
    - m% i& I) X( l4 y. C7 Y) i
29.         Next
    
30. 
    - B3 i1 c$ n8 I% f: X4 G3 q
31.     End If
    3 V/ ]7 [- I! K# J7 b
32. 
    
33. Next
    

复制代码

: b, M. W( ]7 n

machel77

牛，今天帮我解决实际问题了，谢谢

大侠很忙

这两个宏可以合并嘛

奋斗GS

那位麻烦告诉一下，我复制这些代码怎么变了内容？

叶飘零

远祥 发表于 2019-11-19 18:11
+ C. V4 Z. r* A; h+ t1 l# b感觉楼主分享，适用于哪个版本呢？

宏是不分版本的，适用于SW任何版本。

远祥

感觉楼主分享，适用于哪个版本呢？

零度freedom

谢谢楼主，保存先，后面应该有用

叶飘零

删除所有自定义属性
; R$ b. Y1 e+ m: D9 o, _% p

1. Sub main() '删除自定义属性
   - t: B/ l! V7 m
2. Dim swApp As Object
   ! ^* D+ A7 F' `. Q5 j+ j7 p
3. Dim swModel2 As SldWorks.ModelDoc2
   
4. Dim vCustInfoNameArr2 As Variant
   
5. 
   
6. Set swApp = _
   : `; \( t3 }9 X! j" p
7. Application.SldWorks
   # f* }0 N  a' j. B
8. 
   
9. Set swModel2 = swApp.ActiveDoc
   . U% W1 }) f, L9 ~& l7 F: T/ Z* H
10. 
    3 i1 a5 S1 \" h3 U3 Y. I: i4 I
11. vCustInfoNameArr2 = swModel2.GetCustomInfoNames
    
12. 
    
13.   If Not IsEmpty(vCustInfoNameArr2) Then
    
14.      For Each vCustInfoName2 In vCustInfoNameArr2
    
15.          bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
    & u: f5 B& N  _3 e; a
16.       Next
    
17.   End If
    
18. End Sub
    

复制代码