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

zmztx

$ U4 o) m0 J' u- G- b

ryouss 发表于 2019-7-6 11:50
9 n2 I9 n) m* @8 t6 Q6 G( C+ }什麼版本測試的,顯示什麼錯誤提示?

SW2016，还没有装好
刚开始，看到最上面的代码
! v' O3 ~! C0 I. U6 V2 [) p) R

• 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，这样就不行了。
! D1 P+ V6 T8 N; R如果是Function SetSwPart() as object就更清楚了，当然这么些也没错，就是内存多占了一点
) r' F* P" f, q# L2 n" y这段相当于对象指针设置，对吧
1 a% w/ i7 r) M, r/ P; `
如果“在EXCEL修改尺寸”，还有一种办法，用DDE，就是在excel中修改参数后，WS中自动就改过来了
DDE现在似乎只是用在excel中，其他地方不常见了
9 j' p$ A+ l/ S/ `

ryouss

zmztx 发表于 2019-7-8 14:48
SW2016，还没有装好
刚开始，看到最上面的代码

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

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

1. '~~~~~~~~~~~~~~~~~~ 2019/07/06 V19070601 ~~~
   % o) D$ J% F7 V6 s: ^7 ~
2. ' 操作:
   - b  r" k9 w6 B% B, H% I- d5 v
3. '   1. 開 EXCEL文件.
   
4. '   2. 開 SW零件.
   
5. '   3. 執行 ReadSwDimensionInSldPrt().
   5 k- ^, p' ~% b  F- @
6. '   4. 在EXCEL修改尺寸.
   7 g& ]4 P% ^6 E9 T) X$ {$ k
7. '
   
8. ' 功能:
   ( C' q# f2 C( c  J7 G  Y9 j/ Q
9. '   1. 讀取SW零件的全部尺寸,寫到 Excel.
   * b/ o! S  H" X
10. '   2. 在Excel變動尺寸后,修改SW的零件尺寸.
    $ ^: v% i+ R0 F4 U( B
11. '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    
12. 
    " [# z2 I0 N6 L! X6 {/ J2 V
13.   Dim SwApp As Object
    4 a2 q8 ?) U' ]. S9 ?( K: j( Y
14.   Dim boolStatus As Boolean
    
15.   Dim swFeat As Object ', swSubFeat As Object
    ( n9 Z. ~2 R) d, j; P6 r8 T  O& V
16.   Dim swDispDim As Object, SwDim As Object
    8 |; o& t3 ?* g8 p  j5 v, F
17.   Dim Str
    
18.   Dim oDic
    
19.   Dim oArr1, oArr2
    " b3 R5 C: ~  h$ `% j3 z
20.   
    5 ?9 b2 T) H; p0 c
21. Sub ReadSwDimensionInSldPrt()
    
22.   '讀取SW的全部尺寸
    
23.     Set SwApp = Application.SldWorks
    ! Q5 K5 H8 H) ?- k5 T# n4 U' ~
24.     Set Part = SwApp.ActiveDoc
    / d' V" T5 M! S7 X0 q. O
25.     Set oDic = CreateObject("Scripting.Dictionary")
    ; q! L  f) g' O. c0 d
26. '*** Get active sheet in Excel
    7 T- Z( W$ G" C: s$ ]" h; v
27.     Set xl = GetObject(, "Excel.Application")
    
28. With xl.ActiveSheet
    ' k5 W- e/ j. w, _; ?
29.     Set swFeat = Part.FirstFeature
    % p# @6 B( G) l+ H- N) y
30.     kk = 1
    5 V* M; h, B' C, S
31.     Do While Not swFeat Is Nothing
    & A2 k$ ~: P( [! B# g: {
32.         Debug.Print "  " + swFeat.Name
    
33.         'Set swSubFeat = swFeat.GetFirstSubFeature
    ) P5 U+ ?; H) e1 m9 a
34.         Set swDispDim = swFeat.GetFirstDisplayDimension
    2 I" x8 A4 Z' }& @4 b8 x, H
35.         Do While Not swDispDim Is Nothing
    ! b: G% a  e( W7 ?; z
36.             'Set swAnn = swDispDim.GetAnnotation
    % p" ?/ J* A. c& B& W/ w7 }
37.             Set SwDim = swDispDim.GetDimension
    / y3 q3 T. D" ?' W$ {
38.             Str = SwDim.FullName '特徵樹名稱
    
39.             oArr = Split(Str, "@")
    + m/ L2 |: d: }+ O( F
40.             Str = oArr(0) & "@" & oArr(1)
    9 ?* K  W7 ~' G
41.             oDic(Str) = SwDim.GetSystemValue2("")
    
42.             Set swDispDim = swFeat.GetNextDisplayDimension(swDispDim)
    
43.             Debug.Print Str, oDic(Str) ', 符號相當於按Tab鍵
    
44.             kk = kk + 1
    ; d6 T6 O1 A/ M) k+ U$ e" g
45.         Loop
    * N7 w  p5 u, b# X& a( ?- l
46.         Set swFeat = swFeat.GetNextFeature
    
47.     Loop
    
48.     oArr1 = oDic.keys: oArr2 = oDic.Items
    " U& b; o0 j% [
49.     .cells(1, 1) = "Serial number": .cells(1, 2) = "Array staging": .cells(1, 3) = "Dimension name"
    " N5 Q, Q+ P" V3 r2 r
50.     .cells(1, 4) = "Feature name": .cells(1, 5) = "Dimension value"
    4 \+ P* Q. S' ]# @7 Z$ C. t
51.     For kk = 2 To UBound(oArr1) + 2
    - ^# K* z& m( a( J" t2 b1 I) K
52.         .cells(kk, 1) = kk - 2
    
53.         .cells(kk, 2) = "=" & """Arr(""" & " & " & .cells(kk, 1) & " & " & """)="""
    8 ~! X7 C! d! i
54.         .cells(kk, 3) = "'" & Chr(34) & oArr1(kk - 2) & Chr(34)
    
55.         .cells(kk, 4) = Split(oArr1(kk - 2), "@")(1) '(1)僅讀取特徵名
    
56.         .cells(kk, 5) = oArr2(kk - 2)
    
57.     Next kk
    
58. nn = .Range("C65536").End(3).Row 'End(3)==>End(xlUp)
    , @  Q' }6 m1 C' p! Y! }* C
59. Stop '暫停修改Excel之尺寸後,再按RUN執行鍵
    : f$ T9 T3 f4 r/ e$ ?
60. Set Part = SwApp.ActiveDoc
    
61. '依據Excel變動值修改到sw零件
    ( v9 W7 V- t$ \8 p1 N$ A3 x
62. For mm = 2 To nn
    ; z5 S7 t& d' L5 P4 u# E
63.     Size_name = Mid(.cells(mm, 3), 2, Len(.cells(mm, 3)) - 2)
    % O1 x( g7 f, j2 O! ^/ |
64.     Part.Parameter(Size_name).SystemValue = .cells(mm, 5)
    
65. Next mm
    
66. End With
    $ T1 \$ I/ C& ?5 o) T) O" Y
67. boolStatus = Part.EditRebuild3()
    
68. MsgBox "Part size modification ends" '零件尺寸修改結束
    6 I' q3 f9 d' i5 _' Y
69. End Sub
    / S! h% ?( Z1 G; C6 `" S# @

复制代码

2 f8 a1 I+ i7 G1 q+ l  X: O

2. 另也可以直接寫在 EXCEL
1 {4 ~- w/ d& K

( W2 A# u2 C. h$ X

zmztx

我没有去掉function的意思，反而觉得用一些function，sub，更好。容易读，容易改。不过自己用，自己觉得好就好
6 y6 ?  {7 Z2 `0 h) b8 w. ^
“58.nn = .Range("C65536").End(3).Row
你这是Excel2003？
( m+ j& R# Q, M" b8 @从excel，SW的数据读进来，处理以后再写回去
以前在solidedge中，用过这种方式，发现一个问题，solidedge的数据有一个半角字符，写到excel中看不出来。费了不少时间
6 I% g6 ]% ~- \! X* U4 Y这事在sw中不知道有没有