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

zmztx

ryouss 发表于 2019-7-6 11:50
5 g: w3 K0 I# x& B什麼版本測試的,顯示什麼錯誤提示?

SW2016，还没有装好
刚开始，看到最上面的代码

• 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，这样就不行了。
6 T* _5 q  p( s6 I# T( C如果是Function SetSwPart() as object就更清楚了，当然这么些也没错，就是内存多占了一点
7 Z, b- P, v! ~1 P3 ^这段相当于对象指针设置，对吧

9 ^2 B7 `, N. P/ b( f1 s$ p如果“在EXCEL修改尺寸”，还有一种办法，用DDE，就是在excel中修改参数后，WS中自动就改过来了
# L( [9 h0 o5 u, }8 w7 ~" d7 B: hDDE现在似乎只是用在excel中，其他地方不常见了

8 g8 v- P  k1 I' F

ryouss

zmztx 发表于 2019-7-8 14:48
SW2016，还没有装好
. h" _5 b, Y7 ^: ]! ^刚开始，看到最上面的代码

' M; {& P$ e' g" T$ }難得zmztx大大能深入探討很不錯.
! z# L  }, R+ @' O6 @
1. 是可以簡化去掉 Function SetSwPart()

1. '~~~~~~~~~~~~~~~~~~ 2019/07/06 V19070601 ~~~
   + Z1 S( w( J# [
2. ' 操作:
   % S0 n& h! l2 M4 ]8 B
3. '   1. 開 EXCEL文件.
   
4. '   2. 開 SW零件.
   ) a% K7 m7 v$ X" v/ y( }7 {3 Q
5. '   3. 執行 ReadSwDimensionInSldPrt().
   
6. '   4. 在EXCEL修改尺寸.
   $ v( B( k; ~& H9 Q% g, W1 S8 Y0 G) r
7. '
   
8. ' 功能:
   9 S- X) w: J/ T% e: N8 o! A# ~
9. '   1. 讀取SW零件的全部尺寸,寫到 Excel.
   0 |. n# e. c! {8 ^
10. '   2. 在Excel變動尺寸后,修改SW的零件尺寸.
    
11. '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      ?) p6 H; ~: d2 Q% g0 w& \1 T
12. 
    
13.   Dim SwApp As Object
    , t' c8 t+ u" L
14.   Dim boolStatus As Boolean
    
15.   Dim swFeat As Object ', swSubFeat As Object
    . u6 _2 x3 J5 m
16.   Dim swDispDim As Object, SwDim As Object
    - l0 s( Z9 j' W# P
17.   Dim Str
    
18.   Dim oDic
    ; a3 n& s9 I1 H, x3 G0 H
19.   Dim oArr1, oArr2
    
20.   
    ! @) i7 Q, @! i0 ?+ Z) G. Y) o
21. Sub ReadSwDimensionInSldPrt()
    + j& H; V% o! E
22.   '讀取SW的全部尺寸
    
23.     Set SwApp = Application.SldWorks
    
24.     Set Part = SwApp.ActiveDoc
    6 D# V+ L7 l2 h4 t; Z2 }+ D
25.     Set oDic = CreateObject("Scripting.Dictionary")
    6 u4 X9 b' X/ j$ l* y
26. '*** Get active sheet in Excel
    ( ]/ h3 P5 Q6 w1 g* D
27.     Set xl = GetObject(, "Excel.Application")
    5 N4 F% }/ b3 C5 {4 w) x" _5 c
28. With xl.ActiveSheet
    
29.     Set swFeat = Part.FirstFeature
    
30.     kk = 1
    
31.     Do While Not swFeat Is Nothing
    
32.         Debug.Print "  " + swFeat.Name
    4 r- [0 q; t' M" W, V4 J; q$ a
33.         'Set swSubFeat = swFeat.GetFirstSubFeature
    
34.         Set swDispDim = swFeat.GetFirstDisplayDimension
    2 t# A1 o2 F; Q) z
35.         Do While Not swDispDim Is Nothing
    : v- @" R; {8 o, V# {7 B. U' |
36.             'Set swAnn = swDispDim.GetAnnotation
    
37.             Set SwDim = swDispDim.GetDimension
    
38.             Str = SwDim.FullName '特徵樹名稱
    
39.             oArr = Split(Str, "@")
    4 S! ]* L1 B3 ?* C3 i
40.             Str = oArr(0) & "@" & oArr(1)
    
41.             oDic(Str) = SwDim.GetSystemValue2("")
    ) i) X3 y& L2 O6 X* j
42.             Set swDispDim = swFeat.GetNextDisplayDimension(swDispDim)
    6 ~' _: E: V! c
43.             Debug.Print Str, oDic(Str) ', 符號相當於按Tab鍵
    
44.             kk = kk + 1
    - Q* [& M2 @+ |# F
45.         Loop
    
46.         Set swFeat = swFeat.GetNextFeature
    1 ?2 D5 Z1 p9 l
47.     Loop
    " d& @% J2 Z: G, L/ @7 ~
48.     oArr1 = oDic.keys: oArr2 = oDic.Items
    5 t: [0 v7 I, F! G
49.     .cells(1, 1) = "Serial number": .cells(1, 2) = "Array staging": .cells(1, 3) = "Dimension name"
      _7 h9 K: H, N; |6 O0 r8 G
50.     .cells(1, 4) = "Feature name": .cells(1, 5) = "Dimension value"
    " J4 U% [; }6 Z* a% D
51.     For kk = 2 To UBound(oArr1) + 2
    4 j  d  V: k  n; u
52.         .cells(kk, 1) = kk - 2
    
53.         .cells(kk, 2) = "=" & """Arr(""" & " & " & .cells(kk, 1) & " & " & """)="""
    ! W/ @: Y: h4 Y5 V$ b
54.         .cells(kk, 3) = "'" & Chr(34) & oArr1(kk - 2) & Chr(34)
    
55.         .cells(kk, 4) = Split(oArr1(kk - 2), "@")(1) '(1)僅讀取特徵名
    $ u0 @7 L6 F! P; B. E! Y' n
56.         .cells(kk, 5) = oArr2(kk - 2)
    
57.     Next kk
    1 z8 }% H* u- ^1 z
58. nn = .Range("C65536").End(3).Row 'End(3)==>End(xlUp)
    
59. Stop '暫停修改Excel之尺寸後,再按RUN執行鍵
    
60. Set Part = SwApp.ActiveDoc
    0 ^; q( E: y+ d% u* ^6 u5 s. ^. X
61. '依據Excel變動值修改到sw零件
    ! z. P* O  @+ s& _
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)
    
65. Next mm
    0 ?1 R9 F4 o9 ?8 n- E- z; p
66. End With
    , O9 b0 _$ \/ J6 s+ S6 I
67. boolStatus = Part.EditRebuild3()
    
68. MsgBox "Part size modification ends" '零件尺寸修改結束
    9 r8 k8 H! M3 p$ U' B+ N- k" V
69. End Sub
    

复制代码

4 I  v* e% c9 R7 k2 `

5 w, l: H1 z" s5 U& w2. 另也可以直接寫在 EXCEL
3 K2 {# H/ e) c0 f: l& V. L

) K/ Q( {0 o. r. b

zmztx

+ z' O  \2 o- v; a
我没有去掉function的意思，反而觉得用一些function，sub，更好。容易读，容易改。不过自己用，自己觉得好就好

“58.nn = .Range("C65536").End(3).Row
2 c! h0 ^8 H! S你这是Excel2003？
+ a8 |) `$ ]6 r+ {从excel，SW的数据读进来，处理以后再写回去
: M  @! [6 B5 j1 F* ]以前在solidedge中，用过这种方式，发现一个问题，solidedge的数据有一个半角字符，写到excel中看不出来。费了不少时间
这事在sw中不知道有没有
. U! @& `, t; p: [: z! j