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

zmztx

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

SW2016，还没有装好
刚开始，看到最上面的代码
5 x' ]8 l: c4 |! O# X  ]

• 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
  , N$ v6 q" L5 ?5 g  K. e

把function看成了sub，这样就不行了。
如果是Function SetSwPart() as object就更清楚了，当然这么些也没错，就是内存多占了一点
这段相当于对象指针设置，对吧
: [5 i& \* `7 y
如果“在EXCEL修改尺寸”，还有一种办法，用DDE，就是在excel中修改参数后，WS中自动就改过来了
$ g) Y6 h4 p+ U6 A) Q% q$ z/ Z/ o6 Y) |DDE现在似乎只是用在excel中，其他地方不常见了

ryouss

zmztx 发表于 2019-7-8 14:48
* y/ M0 J% J% `2 }( c) p$ nSW2016，还没有装好
刚开始，看到最上面的代码

3 |/ x( g2 H) _難得zmztx大大能深入探討很不錯.

3 B* j0 Q8 o: [! k  f1. 是可以簡化去掉 Function SetSwPart()

1. '~~~~~~~~~~~~~~~~~~ 2019/07/06 V19070601 ~~~
   
2. ' 操作:
   
3. '   1. 開 EXCEL文件.
   2 D. N) k! d9 u8 d
4. '   2. 開 SW零件.
   
5. '   3. 執行 ReadSwDimensionInSldPrt().
   & w: \! J0 U: ~0 V1 i' ?
6. '   4. 在EXCEL修改尺寸.
   
7. '
   
8. ' 功能:
   ' Z/ v/ V, P' u* o8 D
9. '   1. 讀取SW零件的全部尺寸,寫到 Excel.
   
10. '   2. 在Excel變動尺寸后,修改SW的零件尺寸.
    ! v# H& \$ W! ~7 K5 V
11. '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    : D2 c1 n3 g. ?
12. 
    5 w. J: g4 K! G3 c: Y6 k6 J. F
13.   Dim SwApp As Object
    + L1 x  d# l7 r8 C" @! S, J' ^
14.   Dim boolStatus As Boolean
    : b( i& c: ?( z6 i4 j
15.   Dim swFeat As Object ', swSubFeat As Object
    
16.   Dim swDispDim As Object, SwDim As Object
    7 ~" _/ |0 L" g5 j
17.   Dim Str
    ( U: n9 @" _6 X  \( I- G/ |
18.   Dim oDic
    
19.   Dim oArr1, oArr2
    7 z2 U& P- Y! {# `( z+ B8 |. v3 ~
20.   
    
21. Sub ReadSwDimensionInSldPrt()
    
22.   '讀取SW的全部尺寸
    ; ~; y! d. {; Q; S/ R
23.     Set SwApp = Application.SldWorks
    4 ?# X% D# }& ~+ z9 R" r
24.     Set Part = SwApp.ActiveDoc
    
25.     Set oDic = CreateObject("Scripting.Dictionary")
    % Y5 ]! f* `1 U8 q# t
26. '*** Get active sheet in Excel
    
27.     Set xl = GetObject(, "Excel.Application")
    
28. With xl.ActiveSheet
    
29.     Set swFeat = Part.FirstFeature
    $ n1 A, t- A+ x2 @$ F$ E) U: F& c
30.     kk = 1
    
31.     Do While Not swFeat Is Nothing
    # w' ?7 J5 h! _
32.         Debug.Print "  " + swFeat.Name
    4 k, f2 _. J$ m5 U
33.         'Set swSubFeat = swFeat.GetFirstSubFeature
    
34.         Set swDispDim = swFeat.GetFirstDisplayDimension
    , x) H) N. N6 m# I9 t2 v
35.         Do While Not swDispDim Is Nothing
    % m0 ]1 n# i6 K* s4 ~8 x# C
36.             'Set swAnn = swDispDim.GetAnnotation
    ! [  O. e" |7 T
37.             Set SwDim = swDispDim.GetDimension
    
38.             Str = SwDim.FullName '特徵樹名稱
    
39.             oArr = Split(Str, "@")
    
40.             Str = oArr(0) & "@" & oArr(1)
    7 U, R- a. Q/ L( l& z, i0 V) W# `
41.             oDic(Str) = SwDim.GetSystemValue2("")
    
42.             Set swDispDim = swFeat.GetNextDisplayDimension(swDispDim)
    + l8 ]" S+ E+ m2 N+ Q+ {
43.             Debug.Print Str, oDic(Str) ', 符號相當於按Tab鍵
    6 E, y) I0 G5 M* Z( n, o
44.             kk = kk + 1
    / p5 s9 j3 ~: p/ E. q
45.         Loop
    
46.         Set swFeat = swFeat.GetNextFeature
    / E9 d6 i) T! X# ]- Y1 G
47.     Loop
    
48.     oArr1 = oDic.keys: oArr2 = oDic.Items
    2 Y$ w' o3 r8 ]" Z4 ^" m0 u
49.     .cells(1, 1) = "Serial number": .cells(1, 2) = "Array staging": .cells(1, 3) = "Dimension name"
    4 e, S/ l5 }& z" }/ Q  ?- S
50.     .cells(1, 4) = "Feature name": .cells(1, 5) = "Dimension value"
    
51.     For kk = 2 To UBound(oArr1) + 2
    % x9 i# b' \* a6 X# g9 f
52.         .cells(kk, 1) = kk - 2
    " }6 z  D( m: M
53.         .cells(kk, 2) = "=" & """Arr(""" & " & " & .cells(kk, 1) & " & " & """)="""
    0 H3 v; p& A" c( D# ~% y
54.         .cells(kk, 3) = "'" & Chr(34) & oArr1(kk - 2) & Chr(34)
    
55.         .cells(kk, 4) = Split(oArr1(kk - 2), "@")(1) '(1)僅讀取特徵名
    ) {$ f% u7 b" g1 e3 ~4 F
56.         .cells(kk, 5) = oArr2(kk - 2)
    , m  |: \! W2 ~9 u+ i. x
57.     Next kk
    
58. nn = .Range("C65536").End(3).Row 'End(3)==>End(xlUp)
    
59. Stop '暫停修改Excel之尺寸後,再按RUN執行鍵
    4 R' c6 F6 V0 D2 m$ }
60. Set Part = SwApp.ActiveDoc
    " h( i5 Y, ~* }  D( r
61. '依據Excel變動值修改到sw零件
    
62. For mm = 2 To nn
    
63.     Size_name = Mid(.cells(mm, 3), 2, Len(.cells(mm, 3)) - 2)
    5 S; p3 i9 k4 a# L! ^( _
64.     Part.Parameter(Size_name).SystemValue = .cells(mm, 5)
    
65. Next mm
    
66. End With
    $ J( N6 A# B/ x
67. boolStatus = Part.EditRebuild3()
    9 r3 j6 {) Q% U$ ^4 `
68. MsgBox "Part size modification ends" '零件尺寸修改結束
    % k6 p* B' n% C5 W: S0 X4 c  c
69. End Sub
    

复制代码

2. 另也可以直接寫在 EXCEL
3 P/ b& ?( s) s* F1 g
# R/ T" e% K. H6 |
! `0 a. Y& B. V! C" p4 I- f

zmztx

4 T$ u( ]6 T$ J$ P9 A( H# `
我没有去掉function的意思，反而觉得用一些function，sub，更好。容易读，容易改。不过自己用，自己觉得好就好

2 b& [1 [" c" f  j! f- A“58.nn = .Range("C65536").End(3).Row
9 U. U" G+ p0 [你这是Excel2003？
  T) w8 {' E. c. o& M4 P从excel，SW的数据读进来，处理以后再写回去
8 L% |( E; g  y( I7 ~9 [; C以前在solidedge中，用过这种方式，发现一个问题，solidedge的数据有一个半角字符，写到excel中看不出来。费了不少时间
这事在sw中不知道有没有
  F0 ^3 D! v9 e