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

zmztx

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

SW2016，还没有装好
4 h5 `* G, `1 J刚开始，看到最上面的代码

• 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，这样就不行了。
如果是Function SetSwPart() as object就更清楚了，当然这么些也没错，就是内存多占了一点
这段相当于对象指针设置，对吧
' Z! x# ]! f" f
1 L' ]: ^+ E0 b4 @如果“在EXCEL修改尺寸”，还有一种办法，用DDE，就是在excel中修改参数后，WS中自动就改过来了
DDE现在似乎只是用在excel中，其他地方不常见了
8 |* E  v# X9 T+ _
, J7 {8 D/ ~8 s& q/ R' z

ryouss

zmztx 发表于 2019-7-8 14:48
% B( F1 m  Y5 Q/ i6 RSW2016，还没有装好
刚开始，看到最上面的代码

難得zmztx大大能深入探討很不錯.
' S8 `3 e7 @2 a$ u) ~
( H; M( Z# a3 |' N' M9 o% V1. 是可以簡化去掉 Function SetSwPart()
1 Q; E0 Y) Q7 h* b! i# _: \

1. '~~~~~~~~~~~~~~~~~~ 2019/07/06 V19070601 ~~~
   
2. ' 操作:
   ) }6 t0 K* j0 m- S) g
3. '   1. 開 EXCEL文件.
   
4. '   2. 開 SW零件.
   
5. '   3. 執行 ReadSwDimensionInSldPrt().
   # `! A* p" ?) h: i& D) _4 Q2 u
6. '   4. 在EXCEL修改尺寸.
   
7. '
   
8. ' 功能:
   * P2 U( |( M/ x) \6 w1 w3 N
9. '   1. 讀取SW零件的全部尺寸,寫到 Excel.
   + F. L1 t( E' r) D/ M
10. '   2. 在Excel變動尺寸后,修改SW的零件尺寸.
    
11. '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      k6 b% K; {0 x; F2 P
12. 
    
13.   Dim SwApp As Object
    
14.   Dim boolStatus As Boolean
    8 o) j4 @0 H- T0 {% A
15.   Dim swFeat As Object ', swSubFeat As Object
    
16.   Dim swDispDim As Object, SwDim As Object
    1 J0 b8 P  B( r4 ^9 i4 s7 i: Y
17.   Dim Str
    
18.   Dim oDic
    # ?; W! W3 k* Z
19.   Dim oArr1, oArr2
    
20.   
    0 P, p* A( d5 N  W6 H
21. Sub ReadSwDimensionInSldPrt()
    
22.   '讀取SW的全部尺寸
    
23.     Set SwApp = Application.SldWorks
    
24.     Set Part = SwApp.ActiveDoc
    $ r6 H% O7 i; R7 I& E. p4 [4 t  T! A
25.     Set oDic = CreateObject("Scripting.Dictionary")
    
26. '*** Get active sheet in Excel
    
27.     Set xl = GetObject(, "Excel.Application")
    $ a( \% f; c5 v: S
28. With xl.ActiveSheet
    
29.     Set swFeat = Part.FirstFeature
    
30.     kk = 1
    4 N; _1 x. }7 d% c( q: d
31.     Do While Not swFeat Is Nothing
    
32.         Debug.Print "  " + swFeat.Name
    ; p. v( u: Z; `2 _6 ?. ^* F
33.         'Set swSubFeat = swFeat.GetFirstSubFeature
    
34.         Set swDispDim = swFeat.GetFirstDisplayDimension
    . A6 N: K2 d1 D9 x4 U& M+ n
35.         Do While Not swDispDim Is Nothing
    
36.             'Set swAnn = swDispDim.GetAnnotation
    
37.             Set SwDim = swDispDim.GetDimension
    0 ]* {' ^" X9 ]9 X7 J
38.             Str = SwDim.FullName '特徵樹名稱
    7 b9 K0 M, q: A9 I3 c3 S( G$ I
39.             oArr = Split(Str, "@")
    % o) L% ~1 S/ B% x* H6 o) A6 N% J
40.             Str = oArr(0) & "@" & oArr(1)
    
41.             oDic(Str) = SwDim.GetSystemValue2("")
    $ L' y: p4 k: ~$ Q( m
42.             Set swDispDim = swFeat.GetNextDisplayDimension(swDispDim)
    ) [6 S, N( B1 `* P
43.             Debug.Print Str, oDic(Str) ', 符號相當於按Tab鍵
    3 z, V4 L0 v9 }7 ]+ @
44.             kk = kk + 1
    
45.         Loop
    
46.         Set swFeat = swFeat.GetNextFeature
    
47.     Loop
    
48.     oArr1 = oDic.keys: oArr2 = oDic.Items
    
49.     .cells(1, 1) = "Serial number": .cells(1, 2) = "Array staging": .cells(1, 3) = "Dimension name"
    4 |3 n; Y* A. C: ]
50.     .cells(1, 4) = "Feature name": .cells(1, 5) = "Dimension value"
    : V' n9 h: f! b3 |* [5 N5 D
51.     For kk = 2 To UBound(oArr1) + 2
      t* Y7 V% y# M! b
52.         .cells(kk, 1) = kk - 2
    % C! u  L2 E) T; U
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)僅讀取特徵名
    
56.         .cells(kk, 5) = oArr2(kk - 2)
    
57.     Next kk
    ( Q: f# ^% G1 Y- V# i3 f" G& ~
58. nn = .Range("C65536").End(3).Row 'End(3)==>End(xlUp)
    1 w7 Y* |4 }# \: z
59. Stop '暫停修改Excel之尺寸後,再按RUN執行鍵
    
60. Set Part = SwApp.ActiveDoc
    & O$ Q/ Y9 b! A$ ]  f
61. '依據Excel變動值修改到sw零件
    , u7 }0 B: D8 f6 l# K% N
62. For mm = 2 To nn
    3 H! v, v: K4 V4 j& A
63.     Size_name = Mid(.cells(mm, 3), 2, Len(.cells(mm, 3)) - 2)
    % w( i3 D1 a0 I
64.     Part.Parameter(Size_name).SystemValue = .cells(mm, 5)
    
65. Next mm
    2 u$ P( j$ Q1 l; u, m5 \; e5 W, e
66. End With
    
67. boolStatus = Part.EditRebuild3()
    4 x3 t( F( r. s3 X
68. MsgBox "Part size modification ends" '零件尺寸修改結束
    
69. End Sub
    9 `! R2 o5 g% P+ n7 J: [0 X

复制代码

6 w! X  H# m7 g

* l3 K; W- d5 X, }) e- n2. 另也可以直接寫在 EXCEL

zmztx

! y9 s, u$ ^1 k$ U) n( J
我没有去掉function的意思，反而觉得用一些function，sub，更好。容易读，容易改。不过自己用，自己觉得好就好

“58.nn = .Range("C65536").End(3).Row
$ u) R- {- @" N" {# b) m你这是Excel2003？
! y1 m; b" _2 C, A8 S从excel，SW的数据读进来，处理以后再写回去
) g8 \: G' C1 u5 X以前在solidedge中，用过这种方式，发现一个问题，solidedge的数据有一个半角字符，写到excel中看不出来。费了不少时间
$ P$ e( `4 v* D! S8 C这事在sw中不知道有没有