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

zmztx

# O, {+ V5 b& q; M

ryouss 发表于 2019-7-6 11:50
" {( [* z1 K4 M8 g什麼版本測試的,顯示什麼錯誤提示?

9 G7 O% v, Z: O+ RSW2016，还没有装好
刚开始，看到最上面的代码

• 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，这样就不行了。
. z! R5 B1 M% W6 }1 N, s如果是Function SetSwPart() as object就更清楚了，当然这么些也没错，就是内存多占了一点
这段相当于对象指针设置，对吧
  G/ ~2 n# g' `# d* ?' ~
' P3 O: d  Q  r如果“在EXCEL修改尺寸”，还有一种办法，用DDE，就是在excel中修改参数后，WS中自动就改过来了
1 G) m7 m/ W8 w, d5 J8 {- i) UDDE现在似乎只是用在excel中，其他地方不常见了

ryouss

zmztx 发表于 2019-7-8 14:48
SW2016，还没有装好
0 O' p* c, t( L8 B4 g4 |$ a刚开始，看到最上面的代码

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

1. 是可以簡化去掉 Function SetSwPart()
6 a, V8 A3 l) F+ H: n

1. '~~~~~~~~~~~~~~~~~~ 2019/07/06 V19070601 ~~~
   ) x, _6 V! k  E1 W( s# U" f
2. ' 操作:
   
3. '   1. 開 EXCEL文件.
   ) L. w; l) k7 K: F
4. '   2. 開 SW零件.
   + @$ v- @: r1 h; j8 b
5. '   3. 執行 ReadSwDimensionInSldPrt().
   
6. '   4. 在EXCEL修改尺寸.
   
7. '
   
8. ' 功能:
   8 b; W# d; Y! G0 i
9. '   1. 讀取SW零件的全部尺寸,寫到 Excel.
   9 R! B$ R+ \9 F0 |0 N5 M
10. '   2. 在Excel變動尺寸后,修改SW的零件尺寸.
    8 z/ O' r7 a3 R/ w/ h& }( p6 o
11. '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    
12. 
    
13.   Dim SwApp As Object
    
14.   Dim boolStatus As Boolean
    & Q! i& T% c# z+ ^5 x9 {
15.   Dim swFeat As Object ', swSubFeat As Object
    
16.   Dim swDispDim As Object, SwDim As Object
    
17.   Dim Str
    
18.   Dim oDic
    
19.   Dim oArr1, oArr2
    4 b1 X+ t5 S( B
20.   
    8 \5 E" A* M( v$ a
21. Sub ReadSwDimensionInSldPrt()
    
22.   '讀取SW的全部尺寸
    ! R) h) ?$ S$ l5 G# O1 H
23.     Set SwApp = Application.SldWorks
    
24.     Set Part = SwApp.ActiveDoc
    + J+ s. H* d( r3 V; E) c
25.     Set oDic = CreateObject("Scripting.Dictionary")
    4 K. y9 S1 Y! v# s6 B& t7 L
26. '*** Get active sheet in Excel
    
27.     Set xl = GetObject(, "Excel.Application")
    . q4 t$ g1 s: j  g4 L
28. With xl.ActiveSheet
    
29.     Set swFeat = Part.FirstFeature
    
30.     kk = 1
    " C; }# Y. D8 z; v* a- l% b$ G
31.     Do While Not swFeat Is Nothing
    
32.         Debug.Print "  " + swFeat.Name
    : ?4 D8 d5 B: S# S
33.         'Set swSubFeat = swFeat.GetFirstSubFeature
    
34.         Set swDispDim = swFeat.GetFirstDisplayDimension
    / D! ]& S# q- v: y9 j7 V
35.         Do While Not swDispDim Is Nothing
    : j1 I5 J5 A+ j; \. M
36.             'Set swAnn = swDispDim.GetAnnotation
    7 T- t+ a: _" [. O1 X; ^' y
37.             Set SwDim = swDispDim.GetDimension
    : e* ~( l  k$ ~' U: R/ U5 ?) Q
38.             Str = SwDim.FullName '特徵樹名稱
    ; K/ ~8 u% w) M% I
39.             oArr = Split(Str, "@")
    ( }! ]$ ^9 t7 Z: M0 y2 f
40.             Str = oArr(0) & "@" & oArr(1)
    ! l+ N7 T9 \! V- J9 E* Z
41.             oDic(Str) = SwDim.GetSystemValue2("")
    
42.             Set swDispDim = swFeat.GetNextDisplayDimension(swDispDim)
    / X& `& F* E- X5 n* e
43.             Debug.Print Str, oDic(Str) ', 符號相當於按Tab鍵
    
44.             kk = kk + 1
    
45.         Loop
    2 v% \  |+ }" O! B3 L) ]& p( {
46.         Set swFeat = swFeat.GetNextFeature
    " i. y1 U" i: d$ ]
47.     Loop
    ; X7 W7 G  K+ N3 ]
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"
    
51.     For kk = 2 To UBound(oArr1) + 2
    
52.         .cells(kk, 1) = kk - 2
    & B8 W# \1 U$ |$ n
53.         .cells(kk, 2) = "=" & """Arr(""" & " & " & .cells(kk, 1) & " & " & """)="""
    
54.         .cells(kk, 3) = "'" & Chr(34) & oArr1(kk - 2) & Chr(34)
    
55.         .cells(kk, 4) = Split(oArr1(kk - 2), "@")(1) '(1)僅讀取特徵名
    3 U: Q4 ~5 D2 h! O, P, K' P
56.         .cells(kk, 5) = oArr2(kk - 2)
    
57.     Next kk
    
58. nn = .Range("C65536").End(3).Row 'End(3)==>End(xlUp)
    
59. Stop '暫停修改Excel之尺寸後,再按RUN執行鍵
    % p+ ~" [. ]5 N4 `6 A/ {
60. Set Part = SwApp.ActiveDoc
      @8 t$ h; W, r0 q% [5 c
61. '依據Excel變動值修改到sw零件
    
62. For mm = 2 To nn
    $ B3 k' z5 P9 C; x
63.     Size_name = Mid(.cells(mm, 3), 2, Len(.cells(mm, 3)) - 2)
    : G, d4 Z- V3 G$ l$ ^. g  a
64.     Part.Parameter(Size_name).SystemValue = .cells(mm, 5)
    - F' J. j+ g0 B
65. Next mm
    : x# r3 k2 B# a7 R$ w, I) Z1 v" W: K
66. End With
      E& D' \0 r/ [: r" \, V1 z- g
67. boolStatus = Part.EditRebuild3()
    / C) Z+ A9 ?8 q3 k: S' A9 y
68. MsgBox "Part size modification ends" '零件尺寸修改結束
    : S, h+ T; k  w( r. k! o2 b
69. End Sub
    

复制代码

- V( r, M2 T( |) l# V

2. 另也可以直接寫在 EXCEL
8 P) R+ x: g% v' @8 d  }
6 T) N: J, B5 J  F$ u% U9 o( F
3 h, v* V- t/ U2 y

zmztx

2 A; D" f- E0 X
  p5 j$ ]! \* }1 U3 K( H$ M4 w# t- \我没有去掉function的意思，反而觉得用一些function，sub，更好。容易读，容易改。不过自己用，自己觉得好就好
) A7 F9 U: s: E
“58.nn = .Range("C65536").End(3).Row
你这是Excel2003？
$ R4 W2 v+ g. H从excel，SW的数据读进来，处理以后再写回去
( e9 Z5 ~, K7 J+ @以前在solidedge中，用过这种方式，发现一个问题，solidedge的数据有一个半角字符，写到excel中看不出来。费了不少时间
" Z& r+ I$ V! k) `1 A2 k& C0 w% V这事在sw中不知道有没有