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

zmztx

) z. _; p" z7 A9 Z6 X

ryouss 發表于 2019-7-6 11:50
9 {- @* C6 n% ?什麼版本測試的,顯示什麼錯誤提示?

7 |* m, \  l' ^7 ZSW2016，還沒有裝好
  C, X- ~- |; a  t剛開始，看到最上面的代碼

• 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，這樣就不行了。
: ]7 `0 r6 y0 V& {: Y' L) n如果是Function SetSwPart() as object就更清楚了，當然這么些也沒錯，就是內存多占了一點
這段相當于對象指針設置，對吧
) |( e0 ~0 o. c( b; n- I
( X) Z, k5 S5 ]+ J如果“在EXCEL修改尺寸”，還有一種辦法，用DDE，就是在excel中修改參數后，WS中自動就改過來了
DDE現在似乎只是用在excel中，其他地方不常見了

! T& N$ w; W  S  Q5 a

ryouss

zmztx 發表于 2019-7-8 14:48
3 [" k7 \+ c8 V$ bSW2016，還沒有裝好
) Y4 D, ?7 l) d. q' h% l剛開始，看到最上面的代碼

難得zmztx大大能深入探討很不錯.
1 i# J+ ]6 c: }8 O
8 O/ K' j7 G; s# x: a1. 是可以簡化去掉 Function SetSwPart()
" }2 B* [3 g. p8 ^4 K$ R- P

1. '~~~~~~~~~~~~~~~~~~ 2019/07/06 V19070601 ~~~
   
2. ' 操作:
   
3. '   1. 開 EXCEL文件.
   7 `5 l( g. @% r/ B1 L  k
4. '   2. 開 SW零件.
   $ }& c2 n: t7 m  x( {, o3 _
5. '   3. 執行 ReadSwDimensionInSldPrt().
   2 O! O4 ~( h8 J. k6 u
6. '   4. 在EXCEL修改尺寸.
   
7. '
   
8. ' 功能:
   
9. '   1. 讀取SW零件的全部尺寸,寫到 Excel.
   
10. '   2. 在Excel變動尺寸后,修改SW的零件尺寸.
    
11. '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    
12. 
    $ U, S, m- X  ?9 b! R! Y6 t5 Z# M& _
13.   Dim SwApp As Object
    
14.   Dim boolStatus As Boolean
    
15.   Dim swFeat As Object ', swSubFeat As Object
    # r" u6 o" z( P6 {, u
16.   Dim swDispDim As Object, SwDim As Object
    1 N5 ]' [  ?' e
17.   Dim Str
    ' n0 H5 F+ Z  V' p0 ^: P. s5 q
18.   Dim oDic
    " h: Q0 v% t: A* k
19.   Dim oArr1, oArr2
    & A8 i2 ?; ^4 D8 W- }7 i) E6 I, o
20.   
    
21. Sub ReadSwDimensionInSldPrt()
    
22.   '讀取SW的全部尺寸
    ) j9 ~) Q  E) {6 u# ~& j' ^( Q: [
23.     Set SwApp = Application.SldWorks
    
24.     Set Part = SwApp.ActiveDoc
    6 @, |0 P+ V9 g, U  U6 W5 _
25.     Set oDic = CreateObject("Scripting.Dictionary")
    5 e$ m' d7 s  q4 {
26. '*** Get active sheet in Excel
    , i: B, I" Y) @' \) `3 a
27.     Set xl = GetObject(, "Excel.Application")
    
28. With xl.ActiveSheet
    
29.     Set swFeat = Part.FirstFeature
    
30.     kk = 1
    
31.     Do While Not swFeat Is Nothing
    ' Y  g8 j4 [, K! C. r0 }+ `$ I3 V% ]
32.         Debug.Print "  " + swFeat.Name
    % P- }3 I5 b1 k& z
33.         'Set swSubFeat = swFeat.GetFirstSubFeature
    
34.         Set swDispDim = swFeat.GetFirstDisplayDimension
    
35.         Do While Not swDispDim Is Nothing
    
36.             'Set swAnn = swDispDim.GetAnnotation
    
37.             Set SwDim = swDispDim.GetDimension
    
38.             Str = SwDim.FullName '特徵樹名稱
    
39.             oArr = Split(Str, "@")
    
40.             Str = oArr(0) & "@" & oArr(1)
    
41.             oDic(Str) = SwDim.GetSystemValue2("")
    * N3 r, E3 R+ E5 \% A& E/ e* M
42.             Set swDispDim = swFeat.GetNextDisplayDimension(swDispDim)
    
43.             Debug.Print Str, oDic(Str) ', 符號相當於按Tab鍵
    
44.             kk = kk + 1
    
45.         Loop
    ' @% A. e8 X% Q2 r
46.         Set swFeat = swFeat.GetNextFeature
    ) T/ w, ]9 a: r, n; D5 b
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"
    
50.     .cells(1, 4) = "Feature name": .cells(1, 5) = "Dimension value"
    * m; U8 I9 R0 x7 ?0 r# f" W
51.     For kk = 2 To UBound(oArr1) + 2
    : M% ?' x) u$ P
52.         .cells(kk, 1) = kk - 2
    7 q" g7 c$ g" [! h+ k
53.         .cells(kk, 2) = "=" & """Arr(""" & " & " & .cells(kk, 1) & " & " & """)="""
    5 Y0 _8 h2 g9 h
54.         .cells(kk, 3) = "'" & Chr(34) & oArr1(kk - 2) & Chr(34)
    % z" Y* K7 A6 W: e) Y# {
55.         .cells(kk, 4) = Split(oArr1(kk - 2), "@")(1) '(1)僅讀取特徵名
    2 r. K5 H8 S  m$ U8 a+ {8 R
56.         .cells(kk, 5) = oArr2(kk - 2)
    5 ^4 \& u& U& ?' D% E! H1 [. o
57.     Next kk
    
58. nn = .Range("C65536").End(3).Row 'End(3)==>End(xlUp)
    
59. Stop '暫停修改Excel之尺寸後,再按RUN執行鍵
    8 N9 [! ~: x' U
60. Set Part = SwApp.ActiveDoc
    6 H2 f$ ]; N, B# u3 P! c) Y
61. '依據Excel變動值修改到sw零件
    
62. For mm = 2 To nn
    
63.     Size_name = Mid(.cells(mm, 3), 2, Len(.cells(mm, 3)) - 2)
    
64.     Part.Parameter(Size_name).SystemValue = .cells(mm, 5)
    $ E0 w6 S2 W- B0 U" w
65. Next mm
    ; G- b1 ]9 M$ {1 }* d7 c1 c
66. End With
    
67. boolStatus = Part.EditRebuild3()
    ) p6 E4 R8 v3 T2 q: H) Z" m( B
68. MsgBox "Part size modification ends" '零件尺寸修改結束
    
69. End Sub
    3 H/ y5 u4 f+ K+ B4 C( M7 l0 m$ t6 l) T

復制代碼

1 D) h* s/ J1 t1 S# {( X
2. 另也可以直接寫在 EXCEL


2 D4 h# k" `4 p6 ^

zmztx

) ?% @% m  F* ~2 J9 ]2 ?2 O+ b( Q3 k$ I我沒有去掉function的意思，反而覺得用一些function，sub，更好。容易讀，容易改。不過自己用，自己覺得好就好

+ I  E. t; L$ B3 L3 I2 [“58.nn = .Range("C65536").End(3).Row
你這是Excel2003？
從excel，SW的數據讀進來，處理以后再寫回去
以前在solidedge中，用過這種方式，發現一個問題，solidedge的數據有一個半角字符，寫到excel中看不出來。費了不少時間
- O" z* t7 ~: {" u- T  d5 l這事在sw中不知道有沒有
- R+ C4 n* G4 H+ t! W0 a, C