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

zmztx

# B  }: h; v' S# ]5 C; G, h0 S

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

+ g; ], u1 [$ o, n2 _" kSW2016，还没有装好
: y8 D: Q" X  U刚开始，看到最上面的代码
8 t: [: V7 @- P8 C1 Q! P" B

• 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，这样就不行了。
. u+ l# w+ P6 u5 M. C6 Y如果是Function SetSwPart() as object就更清楚了，当然这么些也没错，就是内存多占了一点
这段相当于对象指针设置，对吧
- d+ H& }$ K5 c. w5 h
如果“在EXCEL修改尺寸”，还有一种办法，用DDE，就是在excel中修改参数后，WS中自动就改过来了
$ \( ?; P% E% J% ]8 a. |DDE现在似乎只是用在excel中，其他地方不常见了

+ E; u) q9 u& N

ryouss

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

難得zmztx大大能深入探討很不錯.
8 B% z1 y6 R" _6 p1 \% C5 q- O' C
1. 是可以簡化去掉 Function SetSwPart()
! q6 b* g1 S* G- }- p; Z& B5 v

1. '~~~~~~~~~~~~~~~~~~ 2019/07/06 V19070601 ~~~
   & X2 I# D8 ^: s1 l
2. ' 操作:
   
3. '   1. 開 EXCEL文件.
   
4. '   2. 開 SW零件.
   
5. '   3. 執行 ReadSwDimensionInSldPrt().
   
6. '   4. 在EXCEL修改尺寸.
   
7. '
   
8. ' 功能:
   9 d+ t3 S- @8 E2 u
9. '   1. 讀取SW零件的全部尺寸,寫到 Excel.
   
10. '   2. 在Excel變動尺寸后,修改SW的零件尺寸.
    
11. '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    1 M5 [8 Z# z4 o% R6 F4 R0 J! e
12. 
    
13.   Dim SwApp As Object
    $ P5 y6 {, ~6 z  \
14.   Dim boolStatus As Boolean
    
15.   Dim swFeat As Object ', swSubFeat As Object
    
16.   Dim swDispDim As Object, SwDim As Object
    
17.   Dim Str
    % t) z; M( A  [8 b9 q& c
18.   Dim oDic
    $ b4 L  {# B& B1 j! G8 v
19.   Dim oArr1, oArr2
    
20.   
    ; b6 T9 b6 y' U- I8 {1 z! ^/ h6 j  {
21. Sub ReadSwDimensionInSldPrt()
    
22.   '讀取SW的全部尺寸
    1 h8 V8 C5 q5 a( C9 g: v
23.     Set SwApp = Application.SldWorks
    
24.     Set Part = SwApp.ActiveDoc
    
25.     Set oDic = CreateObject("Scripting.Dictionary")
    . |2 |& K, i& g5 P4 j
26. '*** Get active sheet in Excel
    4 [4 P& x6 \, |4 D5 N4 D# F
27.     Set xl = GetObject(, "Excel.Application")
    
28. With xl.ActiveSheet
    . u4 E' _9 |" r. H' o
29.     Set swFeat = Part.FirstFeature
    5 @3 h2 e6 M; I4 J* d4 ^
30.     kk = 1
    ; j7 i. ~; M4 P8 k) d
31.     Do While Not swFeat Is Nothing
    * |+ A5 D6 |% f
32.         Debug.Print "  " + swFeat.Name
    
33.         'Set swSubFeat = swFeat.GetFirstSubFeature
    + ^% [/ I+ Y& c9 D& M# ~
34.         Set swDispDim = swFeat.GetFirstDisplayDimension
    
35.         Do While Not swDispDim Is Nothing
    ; R: w* v' z5 B! r- F
36.             'Set swAnn = swDispDim.GetAnnotation
    
37.             Set SwDim = swDispDim.GetDimension
    3 p+ s6 s: }  A2 s" U- T; R
38.             Str = SwDim.FullName '特徵樹名稱
    2 |1 M/ d. r+ P: `, M! K
39.             oArr = Split(Str, "@")
    
40.             Str = oArr(0) & "@" & oArr(1)
    . X  H% }( J+ Z2 G& Q
41.             oDic(Str) = SwDim.GetSystemValue2("")
    ; y  [6 y% ~2 ?
42.             Set swDispDim = swFeat.GetNextDisplayDimension(swDispDim)
    3 L+ T8 s; R! v9 }
43.             Debug.Print Str, oDic(Str) ', 符號相當於按Tab鍵
    " ?2 m' d. X- k6 Y1 c
44.             kk = kk + 1
    + ]0 p1 A; d- a, q( B
45.         Loop
    1 z: S/ S* k. F$ p! @/ m
46.         Set swFeat = swFeat.GetNextFeature
    
47.     Loop
    
48.     oArr1 = oDic.keys: oArr2 = oDic.Items
    3 T) d# u+ @6 N! s
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"
    3 `& V1 I/ y6 b* _/ H
51.     For kk = 2 To UBound(oArr1) + 2
    0 r- V6 U; z; j, w5 q8 ]$ q
52.         .cells(kk, 1) = kk - 2
    ; {" Y5 b: Q5 f: g) x$ m' `; L1 q
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)僅讀取特徵名
      a% V; v9 l& K$ D6 k; E, \; ]) A. d& N
56.         .cells(kk, 5) = oArr2(kk - 2)
    ; L& }* ~8 M6 F( {
57.     Next kk
    1 p2 R" G3 \) U- H0 Q9 y" T
58. nn = .Range("C65536").End(3).Row 'End(3)==>End(xlUp)
    
59. Stop '暫停修改Excel之尺寸後,再按RUN執行鍵
    9 {! S8 f5 r3 N* L; t& d- u/ m
60. Set Part = SwApp.ActiveDoc
    : @% m: _2 L6 x3 o# B
61. '依據Excel變動值修改到sw零件
    ! ^' X  K! z9 G; h
62. For mm = 2 To nn
    & ]7 Y* d1 Z4 Z# v5 N- A
63.     Size_name = Mid(.cells(mm, 3), 2, Len(.cells(mm, 3)) - 2)
    9 }0 ]- K5 I7 p- f% ~% I
64.     Part.Parameter(Size_name).SystemValue = .cells(mm, 5)
    / M$ V, ~9 U1 h' R
65. Next mm
      X4 K. v. h- M, c% f! ]& I, ~
66. End With
    
67. boolStatus = Part.EditRebuild3()
    
68. MsgBox "Part size modification ends" '零件尺寸修改結束
    
69. End Sub
    3 X. a# G( g# G# }) `

复制代码

3 L8 a7 Y: j; f& S# e  O4 P) h  U: E) N
& P' A1 R3 V( U3 H& M7 H* E: x
2. 另也可以直接寫在 EXCEL
, ^$ |0 M- r: L: I0 j4 g

4 @9 H7 ]" P; [- v

zmztx

我没有去掉function的意思，反而觉得用一些function，sub，更好。容易读，容易改。不过自己用，自己觉得好就好
6 u& ?( R7 P" K
# {$ `8 o; k8 a! Y“58.nn = .Range("C65536").End(3).Row
, A9 b8 H3 ]' R# j2 d你这是Excel2003？
( H  H! W0 J$ F' ]' k从excel，SW的数据读进来，处理以后再写回去
以前在solidedge中，用过这种方式，发现一个问题，solidedge的数据有一个半角字符，写到excel中看不出来。费了不少时间
这事在sw中不知道有没有