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

ryouss

參考
, ?5 e8 I/ _* Y2 K






# L* S- f5 p) X. c* }9 N- w( K, @& w

1. '~~~~~~~~~~~~~~~~ 2019/07/04 ~~~~~~~~~~~~~~~~
     W& l% H) S. P* Y: B5 j
2. ' 操作:
   
3. '   1. 開 EXCEL文件.
   
4. '   2. 開 SW零件.
   + i" ]. s9 v7 _( b+ L" O) s3 Z
5. '   3. 執行 ReadSwDimensionInSldPrt().
   ; {/ C- I0 k1 T" s; A! Y4 s
6. '   4. 在EXCEL修改尺寸.
   1 R. Q6 D6 q& S' T6 _6 Y
7. '
   
8. ' 功能:
   , Z! l- s( ?6 X0 v
9. '   1. 讀取SW零件的全部尺寸,寫到 Excel.
   / t; Y& q+ r7 ?2 s$ r! ]
10. '   2. 在Excel變動尺寸后,修改SW的零件尺寸.
    9 t$ S6 N4 ?) R/ a% n1 T
11. '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    
12. Function SetSwPart()
    + [9 h  f, b/ ~; a- p
13.   Dim SwApp As Object
    ) K" D  n% S2 e  Z
14.   Dim SelMgr As Object, boolStatus As Boolean
    
15.   Dim longstatus As Long, longwarnings As Long
    
16.   Set SwApp = GetObject(, "sldworks.application")
    2 U6 T9 r5 M& Y$ z  w1 h
17.   Set SetSwPart = SwApp.ActiveDoc
    
18. End Function
    
19. '****************************
    . a. q5 d- R! X" E8 P" h7 E2 y2 U' E& G
20. Private Sub ReadSwDimensionInSldPrt()
    * [$ b) b+ ?# U3 U6 I
21.   '讀取SW的全部尺寸
    
22.   Dim oDic
    
23.   Set oDic = CreateObject("Scripting.Dictionary")
    5 n9 T; |, d! ~2 R9 h% f
24. '*** Get active sheet in Excel
    
25.   Set xl = GetObject(, "Excel.Application")
    + `% Y. t  n1 s$ {4 i" a% G0 a
26.   Set xls = xl.ActiveSheet
      O! S! k$ a* G+ Y" N% H1 G
27. With xls
    
28.     Dim swFeat As Object, swSubFeat As Object
    
29.     Dim swDispDim As Object, SwDim As Object
    
30.     Dim swAnn As Object
    
31.     Dim bRet As Boolean
    
32.     Dim Str
    5 @0 `# |  y) r* `! G
33.     Set SwApp = CreateObject("SldWorks.Application")
    2 l  b' s% S. A2 [" z4 J& W: S
34.     Set SwPart = SetSwPart
    
35.     Set swFeat = SwPart.FirstFeature
    
36.     kk = 1
    4 }4 `6 I/ `$ w" u% g
37.     Do While Not swFeat Is Nothing
    
38.         Debug.Print "  " + swFeat.Name
    0 {( T$ j( W; k9 _1 {
39.         Set swSubFeat = swFeat.GetFirstSubFeature
    
40.         Set swDispDim = swFeat.GetFirstDisplayDimension
    8 O" G1 l; l$ H; m) x& \
41.         Do While Not swDispDim Is Nothing
    - F$ i1 D7 H6 M( v' S
42.             Set swAnn = swDispDim.GetAnnotation
    . z8 D/ I8 M9 H' w- \
43.             Set SwDim = swDispDim.GetDimension
    
44.             'Debug.Print "    [" & SwDim.FullName & "] = " & SwDim.GetSystemValue2("")
    
45.             Debug.Print SwDim.FullName, SwDim.GetSystemValue2("")
    
46.             Str = SwDim.FullName
    
47.             oArr = Split(Str, "@")
      H9 {4 H% S0 I; ~
48.             Str = oArr(0) & "@" & oArr(1)
    . k# |/ \; E, t/ d6 C1 \) J& ^( l4 ~
49.             oDic(Str) = SwDim.GetSystemValue2("")
    
50.             Set swDispDim = swFeat.GetNextDisplayDimension(swDispDim)
    6 F6 ^) A  p6 a$ _& o4 m& o
51.         kk = kk + 1
    
52.         Loop
    
53.         Set swFeat = swFeat.GetNextFeature
    
54.     Loop
    2 t' o' _" T3 I5 F, K4 I
55.     Dim oArr1, oArr2
    7 f/ i8 e9 @- `. L
56.     oArr1 = oDic.keys: oArr2 = oDic.Items
    
57.     .cells(1, 1) = "Serial number": .cells(1, 2) = "Array staging": .cells(1, 3) = "Dimension name"
    2 s* u2 o$ [4 H" M7 y# T! X2 d+ w
58.     .cells(1, 4) = "Feature name": .cells(1, 5) = "Dimension value":
    
59.    
    
60.     For kk = 2 To UBound(oArr1) + 2
    ) {& m1 q  R: N& s
61.         .cells(kk, 1) = kk - 2
    4 Z* R. O+ m% f& T
62.         .cells(kk, 2) = "=" & """Arr(""" & " & " & .cells(kk, 1) & " & " & """)="""
    
63.         .cells(kk, 3) = "'" & Chr(34) & oArr1(kk - 2) & Chr(34)
    
64.         .cells(kk, 4) = Split(oArr1(kk - 2), "@")(1)
    
65.         .cells(kk, 5) = oArr2(kk - 2)
    
66.     Next kk
    , N. \9 l9 u2 X
67. nn = .range("C65536").End(3).Row 'End(3)==>End(xlUp)
    ; h& S. u& @+ T2 m
68. Stop '暫停修改Excel之尺寸後,再按RUN執行鍵
    
69. Set Part = SwApp.ActiveDoc
    
70. '依據Excel變動值修改到sw零件
    0 z; B; L& e, T' @$ [* I$ q
71. For mm = 2 To nn
    % k0 r0 L6 [$ l  A9 Z( j
72.     Size_name = Mid(.cells(mm, 3), 2, Len(.cells(mm, 3)) - 2)
    + z5 _9 d- O3 s6 M
73.     Part.Parameter(Size_name).SystemValue = .cells(mm, 5)
    
74. Next mm
    / x, P9 }8 i" b' a& [
75. End With
    
76. boolStatus = Part.EditRebuild3()
    
77. MsgBox "Part size modification ends" '零件尺寸修改結束
    
78. End Sub
    

复制代码

" j3 z0 t' Q$ D# c6 O) Q
3 Y6 i# e! J+ d/ c

5 T: o! z0 B, n, j

2 P3 q% z  V7 @( E5 L% ^3 Y- Y$ k

zmztx

' y! _5 q% l/ x+ X& S( B我没有去掉function的意思，反而觉得用一些function，sub，更好。容易读，容易改。不过自己用，自己觉得好就好

“58.nn = .Range("C65536").End(3).Row
你这是Excel2003？
从excel，SW的数据读进来，处理以后再写回去
; L& M) [. B- P* L8 {# M, A以前在solidedge中，用过这种方式，发现一个问题，solidedge的数据有一个半角字符，写到excel中看不出来。费了不少时间
; G/ g, X9 b) @4 F; w2 n这事在sw中不知道有没有
, H* n+ W# L1 Q/ p3 G( v3 t# v

ryouss

zmztx 发表于 2019-7-8 14:48
1 k9 g9 ~% V/ K/ zSW2016，还没有装好
刚开始，看到最上面的代码

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

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

1. '~~~~~~~~~~~~~~~~~~ 2019/07/06 V19070601 ~~~
   + f! ~5 `5 g" g$ j& Z% Q+ R
2. ' 操作:
   . J$ O7 T5 D' [$ d
3. '   1. 開 EXCEL文件.
   
4. '   2. 開 SW零件.
   4 m# H1 o; O, Z$ i& k" ]
5. '   3. 執行 ReadSwDimensionInSldPrt().
   
6. '   4. 在EXCEL修改尺寸.
   
7. '
   
8. ' 功能:
   
9. '   1. 讀取SW零件的全部尺寸,寫到 Excel.
   3 X' i6 k; H5 e6 `7 }4 X5 q
10. '   2. 在Excel變動尺寸后,修改SW的零件尺寸.
    
11. '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    
12. 
    4 U) y; ^+ i+ |* l
13.   Dim SwApp As Object
    
14.   Dim boolStatus As Boolean
    
15.   Dim swFeat As Object ', swSubFeat As Object
    / b$ I# {/ w" G5 X; ]  W# Y
16.   Dim swDispDim As Object, SwDim As Object
    9 M6 {" T- n4 Y. |/ e% F/ Z. `
17.   Dim Str
    
18.   Dim oDic
    9 c7 |/ _( n9 m$ K
19.   Dim oArr1, oArr2
    
20.   
    ( V  S# @4 \! V6 G
21. Sub ReadSwDimensionInSldPrt()
    
22.   '讀取SW的全部尺寸
    5 e3 [# x, j6 M: }$ i
23.     Set SwApp = Application.SldWorks
    ( Z$ |4 u4 r$ G) [8 h0 R' S
24.     Set Part = SwApp.ActiveDoc
    
25.     Set oDic = CreateObject("Scripting.Dictionary")
    , F* H1 ]! ~% H/ m# O5 [
26. '*** Get active sheet in Excel
      d- V: V, U/ F6 a, j
27.     Set xl = GetObject(, "Excel.Application")
    7 ~1 ]( k$ D% R0 }' L7 X8 |1 |
28. With xl.ActiveSheet
    , M( s% u+ t9 `, k9 C' H+ }
29.     Set swFeat = Part.FirstFeature
      p# [* E# h6 `% N
30.     kk = 1
    
31.     Do While Not swFeat Is Nothing
    8 V7 z& H, X1 F
32.         Debug.Print "  " + swFeat.Name
    8 j2 K; i/ k7 }7 C2 E3 r! T* V  p$ C3 X
33.         'Set swSubFeat = swFeat.GetFirstSubFeature
    
34.         Set swDispDim = swFeat.GetFirstDisplayDimension
    
35.         Do While Not swDispDim Is Nothing
    
36.             'Set swAnn = swDispDim.GetAnnotation
    0 v' _! v9 r$ F6 I
37.             Set SwDim = swDispDim.GetDimension
    
38.             Str = SwDim.FullName '特徵樹名稱
    / [0 Q3 S) I' C8 o% n5 ^
39.             oArr = Split(Str, "@")
    
40.             Str = oArr(0) & "@" & oArr(1)
    
41.             oDic(Str) = SwDim.GetSystemValue2("")
    
42.             Set swDispDim = swFeat.GetNextDisplayDimension(swDispDim)
    
43.             Debug.Print Str, oDic(Str) ', 符號相當於按Tab鍵
      d1 O$ P7 k5 B2 G( N. ^+ T
44.             kk = kk + 1
    6 i6 K7 e8 d+ h! G8 l
45.         Loop
    3 d- s* M% i( l6 N
46.         Set swFeat = swFeat.GetNextFeature
    4 j: b, t, l. ^, R- G9 ]
47.     Loop
    . E; D; L' m: v. w" l
48.     oArr1 = oDic.keys: oArr2 = oDic.Items
    1 x! G1 u1 o2 {' p
49.     .cells(1, 1) = "Serial number": .cells(1, 2) = "Array staging": .cells(1, 3) = "Dimension name"
    ' d/ ~* O' i# D4 j& G) i7 X5 D; T, \
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
    
53.         .cells(kk, 2) = "=" & """Arr(""" & " & " & .cells(kk, 1) & " & " & """)="""
    
54.         .cells(kk, 3) = "'" & Chr(34) & oArr1(kk - 2) & Chr(34)
    4 E! R1 q  {, ?
55.         .cells(kk, 4) = Split(oArr1(kk - 2), "@")(1) '(1)僅讀取特徵名
    , Z) U' K5 @$ [' ^$ C3 [& N) o
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執行鍵
    
60. Set Part = SwApp.ActiveDoc
    
61. '依據Excel變動值修改到sw零件
    
62. For mm = 2 To nn
    ; A" _( N/ ]; A! C1 j
63.     Size_name = Mid(.cells(mm, 3), 2, Len(.cells(mm, 3)) - 2)
    & E% {' ?# ^. E8 F2 L$ }
64.     Part.Parameter(Size_name).SystemValue = .cells(mm, 5)
    
65. Next mm
    
66. End With
    ; o; Y3 W+ Q' [/ ~
67. boolStatus = Part.EditRebuild3()
    
68. MsgBox "Part size modification ends" '零件尺寸修改結束
    ) G0 j% S4 N* |$ G' @5 B
69. End Sub
    7 k3 u  G' x, ~9 o$ v

复制代码

2. 另也可以直接寫在 EXCEL
& L# C1 V0 ?9 l/ a) p
$ y  Z# e* c2 s$ m

zmztx

* ?+ L& D/ D) m

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

SW2016，还没有装好
8 _3 N. x& d+ Z2 I% G刚开始，看到最上面的代码

• 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，这样就不行了。
( [& t& j) T6 M如果是Function SetSwPart() as object就更清楚了，当然这么些也没错，就是内存多占了一点
这段相当于对象指针设置，对吧
9 w0 i% P5 D; L, z! E, Y2 {; j
如果“在EXCEL修改尺寸”，还有一种办法，用DDE，就是在excel中修改参数后，WS中自动就改过来了
DDE现在似乎只是用在excel中，其他地方不常见了

: ]7 h" V, y0 G, E

远祥

这是神马啊？

ryouss

zmztx 发表于 2019-7-5 16:15
谢谢，我再仔细琢磨
% N  f  |! ]5 D% D3 ~/ i( P- \最上面的function似乎有点不对

什麼版本測試的,顯示什麼錯誤提示?
* A- L7 k9 t5 k) I1 D

zmztx

ryouss 发表于 2019-7-5 11:11
% I" b0 u* v' v0 E3 S7 ASW2017測試OK(有圖可證)

谢谢，我再仔细琢磨
! w, b- E8 A" a; ~+ ?" P最上面的function似乎有点不对

ryouss

zmztx 发表于 2019-7-5 09:57
能给出注释吗？
* F+ d; ^4 g  ~3 P# I9 Z( ~6 q* U* |怎么看上去运行不起来，或者不是全部代码？

SW2017測試OK(有圖可證)


' c) n, W9 ~$ y) W
' ~! [, R, \: a6 W4 E# x0 J9 s

ryouss

7 L8 A! {' X8 N7 G" a  z: e. J
Private Sub ReadSwDimensionInSldPrt()

2 n7 q# s$ b+ w& B1. 執行如上編程,鼠標須放在如上之下.再按"RUN"執行鍵.
2. 在SW2012,2017測試正常.


2 Z8 ]2 |# f- ]* O7 n

zmztx

能给出注释吗？
怎么看上去运行不起来，或者不是全部代码？