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

ryouss

參考

: s/ G% R3 z% U/ B  W
7 _5 M( Q8 D( D& L' U5 j6 i! `
. q2 D. [) N% B

3 s1 S/ t1 G% v7 y& R3 O

$ {' a/ o9 J1 T" _: w" e" ~

1. '~~~~~~~~~~~~~~~~ 2019/07/04 ~~~~~~~~~~~~~~~~
   
2. ' 操作:
   ) x' i/ D; M# T  S5 v
3. '   1. 開 EXCEL文件.
   6 U( r2 c& S! |( w6 }/ `' i
4. '   2. 開 SW零件.
   
5. '   3. 執行 ReadSwDimensionInSldPrt().
   ! }2 }& \9 ]* ~& R" y5 [
6. '   4. 在EXCEL修改尺寸.
   0 |% |$ O1 v% o0 E
7. '
   
8. ' 功能:
   & y: a, X3 [: f7 M4 f
9. '   1. 讀取SW零件的全部尺寸,寫到 Excel.
   
10. '   2. 在Excel變動尺寸后,修改SW的零件尺寸.
    
11. '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    
12. Function SetSwPart()
    & ?) \* l/ L5 h. F
13.   Dim SwApp As Object
    8 o- Z1 M/ t& u, L" |; @
14.   Dim SelMgr As Object, boolStatus As Boolean
    
15.   Dim longstatus As Long, longwarnings As Long
    ! a: s* G! }; @9 Q9 t
16.   Set SwApp = GetObject(, "sldworks.application")
    
17.   Set SetSwPart = SwApp.ActiveDoc
    
18. End Function
    + @! P. W# {+ V: D# k+ v# \
19. '****************************
    2 e# L& u# c: o' J  _7 P
20. Private Sub ReadSwDimensionInSldPrt()
    # s" p2 s! N, Q2 @$ I2 S# B8 j
21.   '讀取SW的全部尺寸
    / }$ `! ~: O  T
22.   Dim oDic
    
23.   Set oDic = CreateObject("Scripting.Dictionary")
    
24. '*** Get active sheet in Excel
    & p4 i# \" `) ]; v2 S  N' I( x( ?
25.   Set xl = GetObject(, "Excel.Application")
    
26.   Set xls = xl.ActiveSheet
    8 P  R# ^7 e! ^1 f. K& R/ E
27. With xls
    
28.     Dim swFeat As Object, swSubFeat As Object
    " s1 M3 e. b. F) d1 a
29.     Dim swDispDim As Object, SwDim As Object
    $ u3 C1 U: D+ t" |/ _
30.     Dim swAnn As Object
    
31.     Dim bRet As Boolean
    ' {( E0 E/ |3 Q3 y3 F9 _, z$ K$ c0 v# K
32.     Dim Str
    6 u: X8 V3 _3 b. v, _" V+ o$ q
33.     Set SwApp = CreateObject("SldWorks.Application")
    . F) j! J0 x2 v1 `
34.     Set SwPart = SetSwPart
    
35.     Set swFeat = SwPart.FirstFeature
    
36.     kk = 1
    
37.     Do While Not swFeat Is Nothing
    
38.         Debug.Print "  " + swFeat.Name
    $ E- @* ]6 Y' s6 V: Q+ Z! H
39.         Set swSubFeat = swFeat.GetFirstSubFeature
    ; R- ~0 e- l6 Z7 s1 Z' b0 m$ a
40.         Set swDispDim = swFeat.GetFirstDisplayDimension
    % T8 Y' x; g; q
41.         Do While Not swDispDim Is Nothing
    6 y  j( n5 v1 u) q5 m7 R* t
42.             Set swAnn = swDispDim.GetAnnotation
    
43.             Set SwDim = swDispDim.GetDimension
    
44.             'Debug.Print "    [" & SwDim.FullName & "] = " & SwDim.GetSystemValue2("")
    
45.             Debug.Print SwDim.FullName, SwDim.GetSystemValue2("")
    
46.             Str = SwDim.FullName
    9 B& U3 `" h& J
47.             oArr = Split(Str, "@")
    
48.             Str = oArr(0) & "@" & oArr(1)
    9 t* I. v( f6 C# R' x
49.             oDic(Str) = SwDim.GetSystemValue2("")
    # o" H4 j( t5 W
50.             Set swDispDim = swFeat.GetNextDisplayDimension(swDispDim)
    
51.         kk = kk + 1
    / y7 p- e0 e+ M+ Q/ R9 F8 K& c
52.         Loop
    # D, f3 o8 w5 P3 J7 b
53.         Set swFeat = swFeat.GetNextFeature
    ( w& T8 f% [  m! t, B2 R, e
54.     Loop
    - i3 c! Y. T; Y* h
55.     Dim oArr1, oArr2
    # P1 h5 H! K6 j0 w& j9 c
56.     oArr1 = oDic.keys: oArr2 = oDic.Items
    
57.     .cells(1, 1) = "Serial number": .cells(1, 2) = "Array staging": .cells(1, 3) = "Dimension name"
    
58.     .cells(1, 4) = "Feature name": .cells(1, 5) = "Dimension value":
    
59.    
    
60.     For kk = 2 To UBound(oArr1) + 2
    / m$ \  q& Z; g9 I
61.         .cells(kk, 1) = kk - 2
    ( {8 u# c9 {7 p: ~& W, s5 R
62.         .cells(kk, 2) = "=" & """Arr(""" & " & " & .cells(kk, 1) & " & " & """)="""
    & k9 F; M3 G/ E, b, h0 ~
63.         .cells(kk, 3) = "'" & Chr(34) & oArr1(kk - 2) & Chr(34)
    4 G1 P- r/ m6 F8 c& g; R/ W( c
64.         .cells(kk, 4) = Split(oArr1(kk - 2), "@")(1)
    
65.         .cells(kk, 5) = oArr2(kk - 2)
    + V# R# r* ^. Q$ G+ e; ^
66.     Next kk
    
67. nn = .range("C65536").End(3).Row 'End(3)==>End(xlUp)
    
68. Stop '暫停修改Excel之尺寸後,再按RUN執行鍵
    
69. Set Part = SwApp.ActiveDoc
    ' n! z, H( i7 F
70. '依據Excel變動值修改到sw零件
    
71. For mm = 2 To nn
    4 o4 ~3 k1 e/ b8 q2 l
72.     Size_name = Mid(.cells(mm, 3), 2, Len(.cells(mm, 3)) - 2)
    # e) h' O1 G5 k: S; @3 r* ]
73.     Part.Parameter(Size_name).SystemValue = .cells(mm, 5)
    6 x8 y+ {( R" }0 @/ s  q
74. Next mm
    , W% M: u3 n5 z- G! `$ t5 {
75. End With
    # k) G  P$ X* {# I8 |6 Y' G
76. boolStatus = Part.EditRebuild3()
    
77. MsgBox "Part size modification ends" '零件尺寸修改結束
    / I, t8 |5 M- @! [3 L+ X7 j9 j
78. End Sub
    2 [1 ]5 ]; o/ e* N

复制代码

( |6 O) G; O) B


) `2 t1 p; |; O% p3 O6 B* ]6 Q2 v
: ~0 T! U' A$ ?  u6 w/ d2 c( r
6 F, K# `* c. U$ Q# T8 |

zmztx

: M& e* p$ x7 S0 R# y5 K我没有去掉function的意思，反而觉得用一些function，sub，更好。容易读，容易改。不过自己用，自己觉得好就好
# g( X% X( Y9 V  ?) I% S9 O
& L5 i3 g3 n4 c- X, E: p- ~; c“58.nn = .Range("C65536").End(3).Row
( S( \9 ~8 `( U你这是Excel2003？
1 T7 o3 Y0 Q  Z1 [, x0 |7 N, x从excel，SW的数据读进来，处理以后再写回去
" K+ U$ C, B9 k0 j8 j7 K以前在solidedge中，用过这种方式，发现一个问题，solidedge的数据有一个半角字符，写到excel中看不出来。费了不少时间
这事在sw中不知道有没有
. O6 X2 ?# j+ p/ l! @% ?

ryouss

zmztx 发表于 2019-7-8 14:48
+ @( e' ?7 Z3 f4 HSW2016，还没有装好
刚开始，看到最上面的代码

8 j2 c  ~6 P1 p% }難得zmztx大大能深入探討很不錯.
! n! Y9 c7 f6 o* O
# a( N  W3 Q, I" o1. 是可以簡化去掉 Function SetSwPart()
; e& s) ?2 ~3 ^1 s5 n1 Z7 A4 u" }/ W

1. '~~~~~~~~~~~~~~~~~~ 2019/07/06 V19070601 ~~~
   
2. ' 操作:
   
3. '   1. 開 EXCEL文件.
   
4. '   2. 開 SW零件.
   
5. '   3. 執行 ReadSwDimensionInSldPrt().
   / P* i! O7 r: S0 _
6. '   4. 在EXCEL修改尺寸.
   
7. '
   
8. ' 功能:
   : p: K/ G2 t2 T  b4 l% O1 [
9. '   1. 讀取SW零件的全部尺寸,寫到 Excel.
   
10. '   2. 在Excel變動尺寸后,修改SW的零件尺寸.
    ( h/ F2 \; x# L+ Q
11. '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    , g4 }* G  l/ e8 ?. I& ~: `
12. 
    - I. f4 q0 S5 M" I4 M  k2 H) Q2 j
13.   Dim SwApp As Object
    
14.   Dim boolStatus As Boolean
    
15.   Dim swFeat As Object ', swSubFeat As Object
    
16.   Dim swDispDim As Object, SwDim As Object
    + J# s% x  J& B5 ~
17.   Dim Str
    8 c  h# T+ G  @7 j7 S
18.   Dim oDic
    
19.   Dim oArr1, oArr2
    ( p- k2 i0 ^  v# s- X& y# f
20.   
    
21. Sub ReadSwDimensionInSldPrt()
    ' u5 ^3 g( R+ P' Y
22.   '讀取SW的全部尺寸
    + g3 T; v- Q6 Q  Y+ S
23.     Set SwApp = Application.SldWorks
    
24.     Set Part = SwApp.ActiveDoc
    
25.     Set oDic = CreateObject("Scripting.Dictionary")
    2 [. E6 @8 M7 T0 i$ P
26. '*** Get active sheet in Excel
    
27.     Set xl = GetObject(, "Excel.Application")
    
28. With xl.ActiveSheet
    
29.     Set swFeat = Part.FirstFeature
    
30.     kk = 1
    ' X1 g! }/ Z6 r5 ]1 V
31.     Do While Not swFeat Is Nothing
    
32.         Debug.Print "  " + swFeat.Name
    
33.         'Set swSubFeat = swFeat.GetFirstSubFeature
    2 g& K2 O* P9 v/ q
34.         Set swDispDim = swFeat.GetFirstDisplayDimension
    3 K8 ]7 K" y& _/ J) L+ v1 J! y  n
35.         Do While Not swDispDim Is Nothing
    - k  `3 l+ C+ k
36.             'Set swAnn = swDispDim.GetAnnotation
    
37.             Set SwDim = swDispDim.GetDimension
    
38.             Str = SwDim.FullName '特徵樹名稱
    
39.             oArr = Split(Str, "@")
    & q; `+ O7 U( [
40.             Str = oArr(0) & "@" & oArr(1)
    
41.             oDic(Str) = SwDim.GetSystemValue2("")
    
42.             Set swDispDim = swFeat.GetNextDisplayDimension(swDispDim)
    9 `$ j% L1 i  b; C9 V/ [  G! Z/ \
43.             Debug.Print Str, oDic(Str) ', 符號相當於按Tab鍵
    4 t- F9 \3 X0 i9 {( G2 }. u6 g, {
44.             kk = kk + 1
    
45.         Loop
    
46.         Set swFeat = swFeat.GetNextFeature
    
47.     Loop
    2 b3 R* U; [, J* }6 j, l- n8 Q1 Z/ U
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"
    + k0 S+ E4 D; b5 b. p: p) H6 W
51.     For kk = 2 To UBound(oArr1) + 2
    0 i9 ~/ u6 K8 _5 ^. N6 R" a
52.         .cells(kk, 1) = kk - 2
    ) [+ [' P# h5 n* ]9 u" z$ P
53.         .cells(kk, 2) = "=" & """Arr(""" & " & " & .cells(kk, 1) & " & " & """)="""
    # p% W3 k( L( q2 B
54.         .cells(kk, 3) = "'" & Chr(34) & oArr1(kk - 2) & Chr(34)
    7 h' ]6 J. ~* C/ `; A
55.         .cells(kk, 4) = Split(oArr1(kk - 2), "@")(1) '(1)僅讀取特徵名
    - `& A" a; x& z
56.         .cells(kk, 5) = oArr2(kk - 2)
    2 K) n# O' h0 j' l. m4 a( s+ }
57.     Next kk
    5 ?+ C2 A( p+ C, S4 E/ c2 N
58. nn = .Range("C65536").End(3).Row 'End(3)==>End(xlUp)
    8 Y& o5 q. L1 `# C4 b
59. Stop '暫停修改Excel之尺寸後,再按RUN執行鍵
    
60. Set Part = SwApp.ActiveDoc
    * }# a6 m( d9 r) f; E9 r
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)
    
65. Next mm
    5 P# j3 W6 c& W/ x% Y/ k! V, k
66. End With
    
67. boolStatus = Part.EditRebuild3()
    
68. MsgBox "Part size modification ends" '零件尺寸修改結束
    8 J+ ]  O6 U5 L) C* L
69. End Sub
    ( H+ B* m; G& P) F: a) {

复制代码

$ E; e( X% _2 w; I( J. |
+ s0 ^" c- d9 S" Y
% {& F7 [5 s8 [2. 另也可以直接寫在 EXCEL

zmztx

ryouss 发表于 2019-7-6 11:50
$ [' A* g6 j8 _: t) R9 @什麼版本測試的,顯示什麼錯誤提示?

9 D+ u. t+ x4 d; PSW2016，还没有装好
刚开始，看到最上面的代码
( e) E8 ?. c1 A0 I& _

• 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
  " ]$ U  E  C% c3 D) C8 b

把function看成了sub，这样就不行了。
如果是Function SetSwPart() as object就更清楚了，当然这么些也没错，就是内存多占了一点
. ?0 K6 q4 ?, O5 x  u' E这段相当于对象指针设置，对吧

如果“在EXCEL修改尺寸”，还有一种办法，用DDE，就是在excel中修改参数后，WS中自动就改过来了
' _2 B3 p( x# @# x' Q  KDDE现在似乎只是用在excel中，其他地方不常见了

远祥

这是神马啊？

ryouss

zmztx 发表于 2019-7-5 16:15
谢谢，我再仔细琢磨
最上面的function似乎有点不对

什麼版本測試的,顯示什麼錯誤提示?

zmztx

ryouss 发表于 2019-7-5 11:11
1 h; a  z0 ]* dSW2017測試OK(有圖可證)

谢谢，我再仔细琢磨
最上面的function似乎有点不对

ryouss

zmztx 发表于 2019-7-5 09:57
# z7 f/ G4 h: W4 O( V能给出注释吗？
怎么看上去运行不起来，或者不是全部代码？

SW2017測試OK(有圖可證)
2 R# F0 \  w6 C( c9 V0 h4 I
' l; v$ k" `3 ^. N. Z- x/ \- x0 J# Z

' Y4 H& }& F# p: ^$ ]- D+ x4 r3 W3 A

ryouss

' ~) Y; }% d% F3 A& e' V
' Z/ L8 e# j5 W2 L( v. @. E* t- PPrivate Sub ReadSwDimensionInSldPrt()
# u  }" I- F) k7 v: H$ b
1. 執行如上編程,鼠標須放在如上之下.再按"RUN"執行鍵.
3 j) R- p6 P. d/ P9 t2. 在SW2012,2017測試正常.

zmztx

能给出注释吗？
# s) ~2 c2 Z' \5 A- S# p6 M8 U怎么看上去运行不起来，或者不是全部代码？