在EXCEL修改SW零件尺寸-宏的練習

zmztx

ryouss 发表于 2019-7-6 11:50
什麼版本測試的,顯示什麼錯誤提示?

SW2016，还没有装好
+ w& u5 f6 ]) x9 I* h, {( P3 ~刚开始，看到最上面的代码
7 d* a) Z1 G& @3 D& o: ?* \. U: q

• Function SetSwPart()* V$ ~6@U! o" v- l"
• Dim SwApp As Object; q& [! u5 L. [5 \) y' P
• Dim SelMgr As Object, boolStatus As Boolean8 y Q+ J6 M, K: x
• Dim longstatus As Long, longwarnings As Long; Y# z3 A7 q' K J' ]" ?0 f5 |4 b. E3
• Set SwApp = GetObject(, "sldworks.application")+ n( E2 d; Y- O; _/ h9 u* Y# Y
• Set SetSwPart = SwApp.ActiveDoc& H) _, N7 I1 F5 a6 z, z
• End Function
  0 `" x+ A3 |" X- j; i

把function看成了sub，这样就不行了。
如果是Function SetSwPart() as object就更清楚了，当然这么些也没错，就是内存多占了一点
这段相当于对象指针设置，对吧
4 J& N; v% i# u3 q1 A& O
如果“在EXCEL修改尺寸”，还有一种办法，用DDE，就是在excel中修改参数后，WS中自动就改过来了
) w _' Y& K4 u9 Z/ i1 g/ ZDDE现在似乎只是用在excel中，其他地方不常见了
; C, v3 ~9 a9 S/ q& x$ _: P5 c! C. t
) f" u( F I: }! `" D) s' N

ryouss

zmztx 发表于 2019-7-8 14:48
. }4 B! m' T% R0 j8 s) L ^SW2016，还没有装好
刚开始，看到最上面的代码

難得zmztx大大能深入探討很不錯.

1. 是可以簡化去掉 Function SetSwPart()

1 k0 O) d% J- `( n- U

1. '~~~~~~~~~~~~~~~~~~ 2019/07/06 V19070601 ~~~
   
2. ' 操作:
   
3. ' 1. 開 EXCEL文件.
   - e" Z& x# r7 C8 Q( Q% J
4. ' 2. 開 SW零件.
   / _( m5 n/ {4 y9 {/ r1 ^# y
5. ' 3. 執行 ReadSwDimensionInSldPrt().
   
6. ' 4. 在EXCEL修改尺寸.
   2 ?& s/ O( p- p6 c3 s4 B! b7 L2 h) Z
7. '
   
8. ' 功能:
   ) Q% m$ u; M3 S7 T4 u% P
9. ' 1. 讀取SW零件的全部尺寸,寫到 Excel.
   9 S4 E1 l+ @( M- p# s" w5 @9 O
10. ' 2. 在Excel變動尺寸后,修改SW的零件尺寸.
    
11. '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    4 F( H( h* h, Z# z/ l
12. 
    : ]4 X, R: ^2 b/ _, u; P
13. Dim SwApp As Object
    * K2 Y3 x( Q$ a- `. o$ R
14. Dim boolStatus As Boolean
    
15. Dim swFeat As Object ', swSubFeat As Object
    
16. Dim swDispDim As Object, SwDim As Object
    
17. Dim Str
    + f; _' z5 E, c- }" R
18. Dim oDic
    
19. Dim oArr1, oArr2
    
20. 
    1 j- a6 Q, p6 L' Y: T/ l2 _
21. Sub ReadSwDimensionInSldPrt()
    
22. '讀取SW的全部尺寸
    
23. Set SwApp = Application.SldWorks
    5 t5 g$ h0 a: a3 _6 Q. o/ R, C
24. Set Part = SwApp.ActiveDoc
    
25. Set oDic = CreateObject("Scripting.Dictionary")
    # g& g7 s: l( w" M, y: X& f
26. '*** Get active sheet in Excel
    : u: g# f1 e+ U9 C/ E
27. Set xl = GetObject(, "Excel.Application")
    + J3 I* E5 e4 Z) i: `
28. With xl.ActiveSheet
    7 T6 z) i0 R1 I- S; t% y3 z* s8 c
29. Set swFeat = Part.FirstFeature
    7 m- A c+ V4 Z0 B! y: c
30. kk = 1
    * r7 \( m b8 n: ]1 S' w
31. Do While Not swFeat Is Nothing
    ( t1 n8 a0 d1 [; B8 d6 r# }
32. Debug.Print " " + swFeat.Name
    8 K* Z: ~% N0 ]4 B) _1 J4 _
33. 'Set swSubFeat = swFeat.GetFirstSubFeature
    
34. Set swDispDim = swFeat.GetFirstDisplayDimension
    , H- m( |1 s" S0 y" j* g( ?
35. Do While Not swDispDim Is Nothing
    ' y" V; ~$ b) i- v4 [
36. 'Set swAnn = swDispDim.GetAnnotation
    
37. Set SwDim = swDispDim.GetDimension
    4 o" x( X' L2 ^
38. Str = SwDim.FullName '特徵樹名稱
    
39. oArr = Split(Str, "@")
    
40. Str = oArr(0) & "@" & oArr(1)
    0 \$ |* B( c" G: W& W( f- q
41. oDic(Str) = SwDim.GetSystemValue2("")
    
42. Set swDispDim = swFeat.GetNextDisplayDimension(swDispDim)
    
43. Debug.Print Str, oDic(Str) ', 符號相當於按Tab鍵
    
44. kk = kk + 1
    
45. Loop
    # S6 K& G0 q. J
46. Set swFeat = swFeat.GetNextFeature
    7 q5 n( |, a: v# H. i3 b
47. Loop
    
48. oArr1 = oDic.keys: oArr2 = oDic.Items
    * w6 ~4 E* \% k5 O+ S
49. .cells(1, 1) = "Serial number": .cells(1, 2) = "Array staging": .cells(1, 3) = "Dimension name"
    # u) F$ J: c8 N
50. .cells(1, 4) = "Feature name": .cells(1, 5) = "Dimension value"
    
51. For kk = 2 To UBound(oArr1) + 2
    
52. .cells(kk, 1) = kk - 2
    
53. .cells(kk, 2) = "=" & """Arr(""" & " & " & .cells(kk, 1) & " & " & """)="""
    7 `& m3 C# y8 Q6 I" a+ t2 `
54. .cells(kk, 3) = "'" & Chr(34) & oArr1(kk - 2) & Chr(34)
    
55. .cells(kk, 4) = Split(oArr1(kk - 2), "@")(1) '(1)僅讀取特徵名
    2 s6 h& l/ y8 L; i7 g
56. .cells(kk, 5) = oArr2(kk - 2)
    ; W9 ~8 m2 _6 N3 U; i6 ^% U1 p
57. Next kk
    ! s2 | O3 w/ D+ T( E' I
58. nn = .Range("C65536").End(3).Row 'End(3)==>End(xlUp)
    
59. Stop '暫停修改Excel之尺寸後,再按RUN執行鍵
    
60. Set Part = SwApp.ActiveDoc
    
61. '依據Excel變動值修改到sw零件
    
62. For mm = 2 To nn
    % s( A5 R' H/ @7 S) z: l" {; k+ j
63. Size_name = Mid(.cells(mm, 3), 2, Len(.cells(mm, 3)) - 2)
    4 A1 N! W1 Q& l& z
64. Part.Parameter(Size_name).SystemValue = .cells(mm, 5)
    
65. Next mm
    
66. End With
    & E) f* }! w" ^9 q G
67. boolStatus = Part.EditRebuild3()
    
68. MsgBox "Part size modification ends" '零件尺寸修改結束
    
69. End Sub
    

复制代码

8 }; b, }" C# E" s: g5 ^5 {/ n, k6 M) f
6 i' }- c( A. Q M* I) M% r
2. 另也可以直接寫在 EXCEL
. f2 |8 K- S1 i6 |5 ^6 f
# S/ `3 H, S/ s; M l) I U

zmztx

; A8 T8 w: r% b; W+ A
我没有去掉function的意思，反而觉得用一些function，sub，更好。容易读，容易改。不过自己用，自己觉得好就好
6 G9 @2 l) S. h2 Q
“58.nn = .Range("C65536").End(3).Row
( d9 O0 K) h0 k2 {- q- i' L3 t) F你这是Excel2003？
从excel，SW的数据读进来，处理以后再写回去
以前在solidedge中，用过这种方式，发现一个问题，solidedge的数据有一个半角字符，写到excel中看不出来。费了不少时间
9 }" y) x- g& O3 v! o这事在sw中不知道有没有
# v* m4 g1 W1 h% m& p' ^4 F