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

zmztx

/ K  Z5 u5 d$ y) l; g

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

; _( {  B+ {1 W/ A, w9 x9 d9 SSW2016，还没有装好
5 U$ z' E$ J) s6 L6 ^/ [刚开始，看到最上面的代码

• 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，这样就不行了。
& E6 b, ]3 G; Y: \0 |如果是Function SetSwPart() as object就更清楚了，当然这么些也没错，就是内存多占了一点
  ?2 l% k9 Q: q8 o  A这段相当于对象指针设置，对吧

( P- b$ e5 N+ ^# \9 p如果“在EXCEL修改尺寸”，还有一种办法，用DDE，就是在excel中修改参数后，WS中自动就改过来了
9 ~2 `4 ^: j- ~2 tDDE现在似乎只是用在excel中，其他地方不常见了

* Y# }3 K! t0 E* E

ryouss

zmztx 发表于 2019-7-8 14:48
& ?0 ]* k' l! W" b* b2 kSW2016，还没有装好
刚开始，看到最上面的代码

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

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

1. '~~~~~~~~~~~~~~~~~~ 2019/07/06 V19070601 ~~~
   
2. ' 操作:
   
3. '   1. 開 EXCEL文件.
   # u2 [7 T& m& T' P
4. '   2. 開 SW零件.
   + k3 o3 ]0 H  c+ Q# C3 [6 Y
5. '   3. 執行 ReadSwDimensionInSldPrt().
   6 I) K! A, l" D$ S  q8 }/ h  H
6. '   4. 在EXCEL修改尺寸.
   3 c- T" x/ U4 |; y/ e1 t% \: I
7. '
     G* M7 {) d' O
8. ' 功能:
   
9. '   1. 讀取SW零件的全部尺寸,寫到 Excel.
   0 l  c& y' a! W  d
10. '   2. 在Excel變動尺寸后,修改SW的零件尺寸.
    8 P7 l0 o: d& T6 ]. D
11. '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    - k' o' m# H' |2 m
12. 
    4 e7 h1 e4 X* h3 f7 f
13.   Dim SwApp As Object
    ) a1 y6 d( N8 e1 ?3 n  C; d
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
    5 U7 `/ Z) _; \+ D. l6 ]
19.   Dim oArr1, oArr2
    0 C' ^( x& y0 m+ D' m9 U$ _
20.   
    ; _, a' N" l# r  T7 {% D' ^
21. Sub ReadSwDimensionInSldPrt()
    & X& U3 ?/ }& K$ M: l" b% Z
22.   '讀取SW的全部尺寸
    
23.     Set SwApp = Application.SldWorks
    4 R% w: O2 K6 L. P% a
24.     Set Part = SwApp.ActiveDoc
    
25.     Set oDic = CreateObject("Scripting.Dictionary")
    
26. '*** Get active sheet in Excel
    2 Z) k5 n* t* G# ~6 V
27.     Set xl = GetObject(, "Excel.Application")
    
28. With xl.ActiveSheet
    
29.     Set swFeat = Part.FirstFeature
    
30.     kk = 1
    - e& d8 D( t7 y7 X, D
31.     Do While Not swFeat Is Nothing
    + Y9 _8 D! a0 c. ~
32.         Debug.Print "  " + swFeat.Name
    0 D9 ]  b& P$ g
33.         'Set swSubFeat = swFeat.GetFirstSubFeature
    
34.         Set swDispDim = swFeat.GetFirstDisplayDimension
      @  ?- D8 K/ J+ h% h7 j
35.         Do While Not swDispDim Is Nothing
    
36.             'Set swAnn = swDispDim.GetAnnotation
    6 d; a0 J5 I2 C# n. q6 D' d
37.             Set SwDim = swDispDim.GetDimension
    $ g$ W+ ~9 u3 \. J- I; X
38.             Str = SwDim.FullName '特徵樹名稱
    , U: d  U% J( J9 H5 P
39.             oArr = Split(Str, "@")
    $ Z# u8 l" U+ t+ O( F
40.             Str = oArr(0) & "@" & oArr(1)
    
41.             oDic(Str) = SwDim.GetSystemValue2("")
    6 b! _& f# L6 a
42.             Set swDispDim = swFeat.GetNextDisplayDimension(swDispDim)
    ( K$ x( y4 E3 _
43.             Debug.Print Str, oDic(Str) ', 符號相當於按Tab鍵
    + q" z* H5 @- b0 p' c- C% l
44.             kk = kk + 1
    
45.         Loop
    3 r* J0 g5 V- j& E
46.         Set swFeat = swFeat.GetNextFeature
    
47.     Loop
    
48.     oArr1 = oDic.keys: oArr2 = oDic.Items
    3 T0 c3 M: l" Q, a$ i
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"
      ?" _* v# v% \; S( p
51.     For kk = 2 To UBound(oArr1) + 2
    
52.         .cells(kk, 1) = kk - 2
    
53.         .cells(kk, 2) = "=" & """Arr(""" & " & " & .cells(kk, 1) & " & " & """)="""
    % w5 e$ C) w& ?# d  f' R8 x# x
54.         .cells(kk, 3) = "'" & Chr(34) & oArr1(kk - 2) & Chr(34)
    # Q: w! ]1 }0 a1 X" o9 ^
55.         .cells(kk, 4) = Split(oArr1(kk - 2), "@")(1) '(1)僅讀取特徵名
    
56.         .cells(kk, 5) = oArr2(kk - 2)
    % e, Q; B* z3 B' A
57.     Next kk
    0 |/ H3 ~( |, s) H6 \7 k
58. nn = .Range("C65536").End(3).Row 'End(3)==>End(xlUp)
    7 |/ L( r( H0 j! Z/ J8 {# Z& q
59. Stop '暫停修改Excel之尺寸後,再按RUN執行鍵
    - q" ^* y, ]1 H( c1 g
60. Set Part = SwApp.ActiveDoc
    6 Z. O8 _5 Q) s. ]! ?7 R
61. '依據Excel變動值修改到sw零件
    " b1 H3 P' I* B
62. For mm = 2 To nn
    * t9 X; G9 s, Y4 `$ z2 r+ J
63.     Size_name = Mid(.cells(mm, 3), 2, Len(.cells(mm, 3)) - 2)
    % D8 t# x5 }/ v3 p% D
64.     Part.Parameter(Size_name).SystemValue = .cells(mm, 5)
    9 R- r9 Z. R0 b
65. Next mm
    
66. End With
    ! j* m2 m$ `, U2 I9 R
67. boolStatus = Part.EditRebuild3()
    * Y9 }; K6 Z- m/ Y7 n6 b
68. MsgBox "Part size modification ends" '零件尺寸修改結束
    & J' X1 p/ J' a) v: l- b
69. End Sub
    

复制代码

1 d$ w/ k9 M. l+ r

2. 另也可以直接寫在 EXCEL
- O' v+ @  Y+ u* U; p* f

- T* M: [* H( L3 F# ]8 i, V- G" u

zmztx

) t* ?- S/ V8 K5 c5 E# G0 c
1 C, k2 x$ Z7 L0 t2 e我没有去掉function的意思，反而觉得用一些function，sub，更好。容易读，容易改。不过自己用，自己觉得好就好
) v  J8 V% K( z2 H7 _6 G
“58.nn = .Range("C65536").End(3).Row
' w  z* o4 W- `! b. M* c8 Y你这是Excel2003？
从excel，SW的数据读进来，处理以后再写回去
7 H$ C) r. u* B6 U% w1 [! n以前在solidedge中，用过这种方式，发现一个问题，solidedge的数据有一个半角字符，写到excel中看不出来。费了不少时间
这事在sw中不知道有没有