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

zmztx

ryouss 发表于 2019-7-6 11:50
. x' q% h! m7 c, ^什麼版本測試的,顯示什麼錯誤提示?

9 b: {4 B" V0 z; H( lSW2016，还没有装好
刚开始，看到最上面的代码
% V- R# u6 V  w6 c

• 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
  * B, r) Z4 e: S; F

把function看成了sub，这样就不行了。
如果是Function SetSwPart() as object就更清楚了，当然这么些也没错，就是内存多占了一点
- g6 f( S; P' J* d+ T$ B9 Y这段相当于对象指针设置，对吧

, H, H- e0 z; y+ B0 u+ Z如果“在EXCEL修改尺寸”，还有一种办法，用DDE，就是在excel中修改参数后，WS中自动就改过来了
4 x- w; ^' ?1 M0 ?DDE现在似乎只是用在excel中，其他地方不常见了

ryouss

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

難得zmztx大大能深入探討很不錯.
# V- g1 \8 ]5 C  C6 @
; n& e- A. N  K5 g! Y, P; ]1. 是可以簡化去掉 Function SetSwPart()

1. '~~~~~~~~~~~~~~~~~~ 2019/07/06 V19070601 ~~~
     _( e8 k" J# ?4 d) c4 ~
2. ' 操作:
   0 t) T7 P; ^7 X! _
3. '   1. 開 EXCEL文件.
   & v# \, N8 l& x9 O0 @
4. '   2. 開 SW零件.
   
5. '   3. 執行 ReadSwDimensionInSldPrt().
   
6. '   4. 在EXCEL修改尺寸.
   
7. '
   # Y8 d3 w. q. z
8. ' 功能:
   
9. '   1. 讀取SW零件的全部尺寸,寫到 Excel.
   
10. '   2. 在Excel變動尺寸后,修改SW的零件尺寸.
    & m3 ^* B+ g. r! Z. H/ ^1 g- A& @4 [
11. '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    1 g5 J7 G4 b3 s; ]
12. 
    . h4 A# Z8 H$ i: S" W3 s' _* Q5 Q$ p  A
13.   Dim SwApp As Object
    $ H- \1 C. i2 o
14.   Dim boolStatus As Boolean
    
15.   Dim swFeat As Object ', swSubFeat As Object
    
16.   Dim swDispDim As Object, SwDim As Object
    
17.   Dim Str
    
18.   Dim oDic
    9 j0 Y0 C+ D5 h  h0 ]
19.   Dim oArr1, oArr2
    ; t) L7 z' B+ `7 I1 ?0 ~: |
20.   
    , T. A9 l5 y- A% ?4 P. c
21. Sub ReadSwDimensionInSldPrt()
    ( \5 u0 V- f: z: P/ W. V/ `; K
22.   '讀取SW的全部尺寸
    
23.     Set SwApp = Application.SldWorks
      a& l0 L7 k$ m; q/ U; o9 ^
24.     Set Part = SwApp.ActiveDoc
    $ G$ f0 W% f: L* T8 Q
25.     Set oDic = CreateObject("Scripting.Dictionary")
    9 j7 D. a& V7 `+ ?
26. '*** Get active sheet in Excel
    
27.     Set xl = GetObject(, "Excel.Application")
    
28. With xl.ActiveSheet
    
29.     Set swFeat = Part.FirstFeature
    & {7 D) t, |" G' w0 S6 S6 E
30.     kk = 1
    
31.     Do While Not swFeat Is Nothing
    ' N  m. I# G" q7 g- g; N
32.         Debug.Print "  " + swFeat.Name
    3 L, Y" }) M) O
33.         'Set swSubFeat = swFeat.GetFirstSubFeature
    0 M: j+ x# @  _' K! m3 S
34.         Set swDispDim = swFeat.GetFirstDisplayDimension
      F0 N9 ]  P9 n8 q
35.         Do While Not swDispDim Is Nothing
    : ?+ Z" [* t9 `& W
36.             'Set swAnn = swDispDim.GetAnnotation
    
37.             Set SwDim = swDispDim.GetDimension
    - |1 F$ j( _# C' H
38.             Str = SwDim.FullName '特徵樹名稱
    , K" S2 z5 b: E) y, [: g. F
39.             oArr = Split(Str, "@")
    ) m" D  H# I: G2 S
40.             Str = oArr(0) & "@" & oArr(1)
    4 M5 s8 c2 G6 b" ~* G, {
41.             oDic(Str) = SwDim.GetSystemValue2("")
    
42.             Set swDispDim = swFeat.GetNextDisplayDimension(swDispDim)
    : Y+ f4 |" E' g1 L
43.             Debug.Print Str, oDic(Str) ', 符號相當於按Tab鍵
    
44.             kk = kk + 1
    
45.         Loop
    
46.         Set swFeat = swFeat.GetNextFeature
    
47.     Loop
    0 t5 z0 F4 J/ W2 N& q
48.     oArr1 = oDic.keys: oArr2 = oDic.Items
    0 L  O- K" m1 }: L, |
49.     .cells(1, 1) = "Serial number": .cells(1, 2) = "Array staging": .cells(1, 3) = "Dimension name"
    8 p5 t& [. M) e# H& E
50.     .cells(1, 4) = "Feature name": .cells(1, 5) = "Dimension value"
    $ T3 c+ U8 D% l$ l$ f' N. H
51.     For kk = 2 To UBound(oArr1) + 2
    6 n# J* j- T7 e2 D
52.         .cells(kk, 1) = kk - 2
    . F; @+ D& ]5 \
53.         .cells(kk, 2) = "=" & """Arr(""" & " & " & .cells(kk, 1) & " & " & """)="""
    ' S7 A( l: X3 t$ o, g
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)
    & z* e( ]# |5 r7 M! D$ f
57.     Next kk
    8 v3 d# r: \3 @/ d- g# I
58. nn = .Range("C65536").End(3).Row 'End(3)==>End(xlUp)
    
59. Stop '暫停修改Excel之尺寸後,再按RUN執行鍵
    1 F* m+ Y# d: R
60. Set Part = SwApp.ActiveDoc
    
61. '依據Excel變動值修改到sw零件
    8 E3 q- u5 s  t9 R5 H3 ^
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)
    * ~" ^. y: z  y( A4 f  S
65. Next mm
    , H- x3 l& L3 S! B% m+ M" F. m  z
66. End With
    7 K3 i$ b# D& D" A% H" Y
67. boolStatus = Part.EditRebuild3()
    
68. MsgBox "Part size modification ends" '零件尺寸修改結束
    
69. End Sub
    / h) k6 z" V* T9 d3 j

复制代码

6 h/ k; f0 ^+ ]5 H$ h: X: f

2. 另也可以直接寫在 EXCEL

% j+ H5 Y( H: h% n% @

zmztx

+ x) ^0 B! {  U& x/ v
我没有去掉function的意思，反而觉得用一些function，sub，更好。容易读，容易改。不过自己用，自己觉得好就好

“58.nn = .Range("C65536").End(3).Row
+ p  c) `: f9 ^) i你这是Excel2003？
& [8 h/ C9 [# v+ b) k  Y1 J$ b从excel，SW的数据读进来，处理以后再写回去
+ Q/ u2 ^2 K9 n$ Y9 O以前在solidedge中，用过这种方式，发现一个问题，solidedge的数据有一个半角字符，写到excel中看不出来。费了不少时间
这事在sw中不知道有没有