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

zmztx

ryouss 發(fā)表于 2019-7-6 11:50
6 d+ H; n2 u5 g什麼版本測試的,顯示什麼錯誤提示?

SW2016，還沒有裝好
) V4 c7 p5 z1 z* C. K. T剛開始，看到最上面的代碼
; K; u' o4 M2 E8 Z* U

• 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
  

把function看成了sub，這樣就不行了。
4 |$ k" A$ V4 D5 X' ], p如果是Function SetSwPart() as object就更清楚了，當然這么些也沒錯，就是內存多占了一點
/ p( K$ C, ]  }$ T/ K; d8 h這段相當于對象指針設置，對吧

如果“在EXCEL修改尺寸”，還有一種辦法，用DDE，就是在excel中修改參數后，WS中自動就改過來了
2 O! t/ F# }; C4 {0 {DDE現(xiàn)在似乎只是用在excel中，其他地方不常見了

ryouss

zmztx 發(fā)表于 2019-7-8 14:48
SW2016，還沒有裝好
& @& J' u2 q8 a) o) x5 X6 U剛開始，看到最上面的代碼

難得zmztx大大能深入探討很不錯.
; B' X* E4 H, e( ?$ z1 {
& G: b- Q! j: l9 W  P$ [+ E/ F; h1. 是可以簡化去掉 Function SetSwPart()
  B: P) i4 |* q4 A4 n

1. '~~~~~~~~~~~~~~~~~~ 2019/07/06 V19070601 ~~~
   ) E/ V4 {9 L! r
2. ' 操作:
   ! L( O7 i% X/ p
3. '   1. 開 EXCEL文件.
   
4. '   2. 開 SW零件.
   ) d+ s; c! A: @( o* G
5. '   3. 執(zhí)行 ReadSwDimensionInSldPrt().
   
6. '   4. 在EXCEL修改尺寸.
   
7. '
   2 ]0 V' D- k4 p2 @' z
8. ' 功能:
   
9. '   1. 讀取SW零件的全部尺寸,寫到 Excel.
   1 c5 L$ x9 N' z
10. '   2. 在Excel變動尺寸后,修改SW的零件尺寸.
    # a* M2 r1 o* u: y
11. '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    
12. 
    ! M1 S* q+ }7 H7 b/ y2 `8 X
13.   Dim SwApp As Object
    : l/ g& B" S0 t/ W2 V0 u
14.   Dim boolStatus As Boolean
    
15.   Dim swFeat As Object ', swSubFeat As Object
    
16.   Dim swDispDim As Object, SwDim As Object
    
17.   Dim Str
    
18.   Dim oDic
    / g( j/ k3 D: S4 ?- L
19.   Dim oArr1, oArr2
      ]- R" P; M( \9 |* x% _2 r9 K
20.   
      H" S5 H, v. q( \
21. Sub ReadSwDimensionInSldPrt()
    
22.   '讀取SW的全部尺寸
    
23.     Set SwApp = Application.SldWorks
    # d0 w% j$ Z) d% R9 N, _
24.     Set Part = SwApp.ActiveDoc
    
25.     Set oDic = CreateObject("Scripting.Dictionary")
    
26. '*** Get active sheet in Excel
    
27.     Set xl = GetObject(, "Excel.Application")
    
28. With xl.ActiveSheet
    ( \* {4 D$ ?5 m6 e) C1 k4 c
29.     Set swFeat = Part.FirstFeature
    9 [) O7 |, o& m; B$ o
30.     kk = 1
    
31.     Do While Not swFeat Is Nothing
    
32.         Debug.Print "  " + swFeat.Name
    9 @7 t# K% ]/ {3 h* E
33.         'Set swSubFeat = swFeat.GetFirstSubFeature
    . `' a% L* ~' ]7 n" T" `0 q
34.         Set swDispDim = swFeat.GetFirstDisplayDimension
    
35.         Do While Not swDispDim Is Nothing
    2 S' O- R. B& A# I" M2 j0 |
36.             'Set swAnn = swDispDim.GetAnnotation
    
37.             Set SwDim = swDispDim.GetDimension
    + j  q6 }) u7 H
38.             Str = SwDim.FullName '特徵樹名稱
    
39.             oArr = Split(Str, "@")
    - c$ v: h8 j0 w8 W! }
40.             Str = oArr(0) & "@" & oArr(1)
    7 c, d  u6 c8 s  U9 G! i3 S
41.             oDic(Str) = SwDim.GetSystemValue2("")
    * h) E' M6 j4 H) r+ d) b2 j) T: _
42.             Set swDispDim = swFeat.GetNextDisplayDimension(swDispDim)
    
43.             Debug.Print Str, oDic(Str) ', 符號相當於按Tab鍵
    
44.             kk = kk + 1
    ! l. N1 d! _% `
45.         Loop
    
46.         Set swFeat = swFeat.GetNextFeature
    
47.     Loop
    
48.     oArr1 = oDic.keys: oArr2 = oDic.Items
    
49.     .cells(1, 1) = "Serial number": .cells(1, 2) = "Array staging": .cells(1, 3) = "Dimension name"
    3 W9 H; x% F; J' p* ^
50.     .cells(1, 4) = "Feature name": .cells(1, 5) = "Dimension value"
      L$ b* ^4 K9 }8 @: W2 l1 W
51.     For kk = 2 To UBound(oArr1) + 2
    4 E  q' B$ Z! N* P& m9 ?- _
52.         .cells(kk, 1) = kk - 2
    
53.         .cells(kk, 2) = "=" & """Arr(""" & " & " & .cells(kk, 1) & " & " & """)="""
    
54.         .cells(kk, 3) = "'" & Chr(34) & oArr1(kk - 2) & Chr(34)
    ' o6 A* z5 [. `) }1 U: h, O1 ?
55.         .cells(kk, 4) = Split(oArr1(kk - 2), "@")(1) '(1)僅讀取特徵名
    " O0 N8 b# z% h* ?; U  g8 ]
56.         .cells(kk, 5) = oArr2(kk - 2)
    # b- t- u( }' x* x1 [! a
57.     Next kk
    
58. nn = .Range("C65536").End(3).Row 'End(3)==>End(xlUp)
    2 j, k, n! W0 L
59. Stop '暫停修改Excel之尺寸後,再按RUN執(zhí)行鍵
    / d' D( S2 T8 E: A" [
60. Set Part = SwApp.ActiveDoc
    
61. '依據Excel變動值修改到sw零件
    " w/ q5 ~2 V. w9 q& o% f) S1 w# s8 Z) p
62. For mm = 2 To nn
    
63.     Size_name = Mid(.cells(mm, 3), 2, Len(.cells(mm, 3)) - 2)
    1 }& ^) W8 {5 X+ Z+ T; \" O
64.     Part.Parameter(Size_name).SystemValue = .cells(mm, 5)
    
65. Next mm
    / Z0 {& h$ w7 R, m$ G  X
66. End With
    2 a$ M* W1 _: I: g# C" Y
67. boolStatus = Part.EditRebuild3()
    
68. MsgBox "Part size modification ends" '零件尺寸修改結束
    
69. End Sub
    

復制代碼

2 g/ i0 h' V6 H
1 g$ x% M9 u- l6 O( d# j
* `- \5 y& Y# q9 u) V+ f2. 另也可以直接寫在 EXCEL
+ U  J1 o! [) b  W0 e! ?9 o
8 Q/ w: {0 U, F$ w! H7 c
* x2 O' ^8 F* S( j

zmztx

0 T1 ?8 U# z& D: z% F! I我沒有去掉function的意思，反而覺得用一些function，sub，更好。容易讀，容易改。不過自己用，自己覺得好就好
9 n4 ^, F; T2 \4 L
5 b* x  Q+ d/ X0 Q“58.nn = .Range("C65536").End(3).Row
8 @- P  N% d4 ]8 d& A你這是Excel2003？
9 x9 X" b+ p1 x7 }9 i5 O從excel，SW的數據讀進來，處理以后再寫回去
以前在solidedge中，用過這種方式，發(fā)現(xiàn)一個問題，solidedge的數據有一個半角字符，寫到excel中看不出來。費了不少時間
+ v1 v- V; x0 |1 u- U這事在sw中不知道有沒有