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

zmztx

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

6 n! P* @+ A7 d* dSW2016，还没有装好
刚开始，看到最上面的代码
3 v+ W1 O$ [2 A

• 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就更清楚了，当然这么些也没错，就是内存多占了一点
这段相当于对象指针设置，对吧

9 X8 ~3 Q! ]; L如果“在EXCEL修改尺寸”，还有一种办法，用DDE，就是在excel中修改参数后，WS中自动就改过来了
& h& k7 ^1 _+ `: L3 PDDE现在似乎只是用在excel中，其他地方不常见了

, O+ A' @! y1 C

ryouss

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

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

% f1 |& q& A2 }1. 是可以簡化去掉 Function SetSwPart()

4 n& D1 T5 _$ r5 a

1. '~~~~~~~~~~~~~~~~~~ 2019/07/06 V19070601 ~~~
   
2. ' 操作:
   2 [3 @5 J6 X8 x* o' n4 U
3. '   1. 開 EXCEL文件.
   
4. '   2. 開 SW零件.
   
5. '   3. 執行 ReadSwDimensionInSldPrt().
   
6. '   4. 在EXCEL修改尺寸.
   6 I5 q; f9 ~0 n
7. '
   
8. ' 功能:
   
9. '   1. 讀取SW零件的全部尺寸,寫到 Excel.
   # `: f2 j7 ~5 w) l& m, H3 f
10. '   2. 在Excel變動尺寸后,修改SW的零件尺寸.
    
11. '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    2 ]0 Z( [& f* x$ q
12. 
    6 C* U; i5 p0 f2 U' h
13.   Dim SwApp As Object
    
14.   Dim boolStatus As Boolean
    . C& \% a% r$ T9 |1 W
15.   Dim swFeat As Object ', swSubFeat As Object
    
16.   Dim swDispDim As Object, SwDim As Object
    0 V: _  c; K# v0 G
17.   Dim Str
    % h6 D/ t) P6 z- S7 P% o, F1 n9 Y
18.   Dim oDic
    
19.   Dim oArr1, oArr2
    3 d8 Q' U$ F- @6 e
20.   
    $ @; l8 j0 n8 q2 z- {
21. Sub ReadSwDimensionInSldPrt()
    ) X* V- p# }9 a$ b  l- o
22.   '讀取SW的全部尺寸
    ' x& I% }- ^3 Z6 S, V
23.     Set SwApp = Application.SldWorks
    ! l  K* J; Q3 m
24.     Set Part = SwApp.ActiveDoc
    " S& ]. L7 O8 x
25.     Set oDic = CreateObject("Scripting.Dictionary")
    
26. '*** Get active sheet in Excel
    
27.     Set xl = GetObject(, "Excel.Application")
    
28. With xl.ActiveSheet
    $ s# h" e& w8 C. a/ ^) t
29.     Set swFeat = Part.FirstFeature
    : \" n! i. v) q" z
30.     kk = 1
    / S, |3 Q% ?7 l3 p
31.     Do While Not swFeat Is Nothing
    . c6 m$ J- I3 e/ K0 y) F
32.         Debug.Print "  " + swFeat.Name
    ' {$ A. p% Q0 j2 P
33.         'Set swSubFeat = swFeat.GetFirstSubFeature
    ) l' s* e: [4 i/ a/ z# b" R5 w
34.         Set swDispDim = swFeat.GetFirstDisplayDimension
    
35.         Do While Not swDispDim Is Nothing
    
36.             'Set swAnn = swDispDim.GetAnnotation
    
37.             Set SwDim = swDispDim.GetDimension
    
38.             Str = SwDim.FullName '特徵樹名稱
    
39.             oArr = Split(Str, "@")
    
40.             Str = oArr(0) & "@" & oArr(1)
    2 ^6 f9 m4 K, @) X$ c
41.             oDic(Str) = SwDim.GetSystemValue2("")
    
42.             Set swDispDim = swFeat.GetNextDisplayDimension(swDispDim)
    . m# ~" F: B, E! \/ n- _
43.             Debug.Print Str, oDic(Str) ', 符號相當於按Tab鍵
    
44.             kk = kk + 1
    
45.         Loop
    
46.         Set swFeat = swFeat.GetNextFeature
    # o6 Y+ E5 f% l0 B' b; ^; O
47.     Loop
    
48.     oArr1 = oDic.keys: oArr2 = oDic.Items
    3 n0 e- t9 T( w6 |+ H. l4 K
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"
    ; C* y) F# C" }% X/ U0 G7 o+ K
51.     For kk = 2 To UBound(oArr1) + 2
    : p! T: g- |- z. v9 V) }, |( M
52.         .cells(kk, 1) = kk - 2
    9 n4 [9 Y  T5 |2 O" X" ?
53.         .cells(kk, 2) = "=" & """Arr(""" & " & " & .cells(kk, 1) & " & " & """)="""
    
54.         .cells(kk, 3) = "'" & Chr(34) & oArr1(kk - 2) & Chr(34)
    ) U2 I4 x# c. F+ L1 i7 q) o& i. `% F; g
55.         .cells(kk, 4) = Split(oArr1(kk - 2), "@")(1) '(1)僅讀取特徵名
    - i* k1 v8 d) o6 z. [5 X# B( ?- t
56.         .cells(kk, 5) = oArr2(kk - 2)
    
57.     Next kk
    
58. nn = .Range("C65536").End(3).Row 'End(3)==>End(xlUp)
    & {" [4 F: `& m1 [1 o( W$ @+ @
59. Stop '暫停修改Excel之尺寸後,再按RUN執行鍵
    ! `5 W+ }; |: ]9 Y7 |% g4 k. ?
60. Set Part = SwApp.ActiveDoc
    
61. '依據Excel變動值修改到sw零件
    
62. For mm = 2 To nn
    6 c5 H5 @1 ~) D" y: d/ w; u, k4 H
63.     Size_name = Mid(.cells(mm, 3), 2, Len(.cells(mm, 3)) - 2)
    + E! q" r. f9 j) P9 F
64.     Part.Parameter(Size_name).SystemValue = .cells(mm, 5)
    
65. Next mm
    : S  I, ?; }' ^3 n2 @+ n% M+ c
66. End With
    8 s$ O9 v. g$ [8 i
67. boolStatus = Part.EditRebuild3()
    - I$ s7 P0 V+ z. D7 f, p% ~/ M
68. MsgBox "Part size modification ends" '零件尺寸修改結束
    1 U* @% l3 ^( g- a4 E. ]
69. End Sub
    5 q; H2 A8 H) y" g& t

复制代码

2. 另也可以直接寫在 EXCEL
; _3 N# ?- m5 c& r) n' k

zmztx

' `. w) R2 E/ H: o8 B) g2 i* d
我没有去掉function的意思，反而觉得用一些function，sub，更好。容易读，容易改。不过自己用，自己觉得好就好
8 M: U  Z3 K  P2 B' O
“58.nn = .Range("C65536").End(3).Row
# M% M& M8 {0 Q7 o: K4 i! g& ~你这是Excel2003？
/ X9 N3 [* T: V从excel，SW的数据读进来，处理以后再写回去
以前在solidedge中，用过这种方式，发现一个问题，solidedge的数据有一个半角字符，写到excel中看不出来。费了不少时间
' {: a) W0 s: w" s这事在sw中不知道有没有