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

zmztx

ryouss 发表于 2019-7-6 11:50
" Z; E& c; G  W$ y& q& ~  [/ t4 R什麼版本測試的,顯示什麼錯誤提示?

. `8 E, S& P  z4 x* h! N. F0 GSW2016，还没有装好
刚开始，看到最上面的代码
! g0 i) y0 t0 @  u

• 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
  % F' @" Z4 A$ h" J9 A& L' c- E

把function看成了sub，这样就不行了。
如果是Function SetSwPart() as object就更清楚了，当然这么些也没错，就是内存多占了一点
4 W1 q; ]# `7 o这段相当于对象指针设置，对吧

如果“在EXCEL修改尺寸”，还有一种办法，用DDE，就是在excel中修改参数后，WS中自动就改过来了
8 l5 v, `. ]! CDDE现在似乎只是用在excel中，其他地方不常见了
; D) Y' L* V1 d' R2 `
* s; N1 I  _/ M8 |6 T( L

ryouss

zmztx 发表于 2019-7-8 14:48
SW2016，还没有装好
% w; J( z' ^3 R$ ^( O- y刚开始，看到最上面的代码

8 W, N1 z/ R, q9 v難得zmztx大大能深入探討很不錯.
" n  O- g3 q6 _. B3 W
3 y/ k9 b) {& G# b1 e: `) b+ w4 q1. 是可以簡化去掉 Function SetSwPart()

1. '~~~~~~~~~~~~~~~~~~ 2019/07/06 V19070601 ~~~
   
2. ' 操作:
   % a$ s1 F! i6 u' v  F* _
3. '   1. 開 EXCEL文件.
   
4. '   2. 開 SW零件.
   
5. '   3. 執行 ReadSwDimensionInSldPrt().
   4 Q4 u" h9 L$ V1 D, ]2 ~5 r- G, O
6. '   4. 在EXCEL修改尺寸.
   ( P& R  J/ V3 O/ l. o4 J6 ^
7. '
   
8. ' 功能:
   # [# E2 w% h3 t3 d6 n2 t
9. '   1. 讀取SW零件的全部尺寸,寫到 Excel.
   : {, z3 k, t, N2 z7 U
10. '   2. 在Excel變動尺寸后,修改SW的零件尺寸.
    
11. '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    
12. 
    
13.   Dim SwApp As Object
    
14.   Dim boolStatus As Boolean
    . s) u/ n. v' c4 r' n# K: l5 o$ S! a
15.   Dim swFeat As Object ', swSubFeat As Object
    : M* h3 y4 A1 G+ t
16.   Dim swDispDim As Object, SwDim As Object
    ) \+ Q& T9 Z8 i' q
17.   Dim Str
    
18.   Dim oDic
    * V7 P# e5 K& J% p9 N
19.   Dim oArr1, oArr2
    
20.   
    ( P6 E3 V0 U: ~' l: \+ t+ X
21. Sub ReadSwDimensionInSldPrt()
    4 b: u; f/ a) F+ Z5 h! b2 q
22.   '讀取SW的全部尺寸
    5 g3 P) f0 I  @7 S# C8 h
23.     Set SwApp = Application.SldWorks
    
24.     Set Part = SwApp.ActiveDoc
    
25.     Set oDic = CreateObject("Scripting.Dictionary")
    0 L' r0 X  p+ K2 }9 |1 H& I! X
26. '*** Get active sheet in Excel
    # y, C1 i- F6 M5 t0 [" ~5 r
27.     Set xl = GetObject(, "Excel.Application")
    
28. With xl.ActiveSheet
    
29.     Set swFeat = Part.FirstFeature
    
30.     kk = 1
    
31.     Do While Not swFeat Is Nothing
    
32.         Debug.Print "  " + swFeat.Name
    . y% P! ^) G1 G' w2 }3 x# v* N2 y
33.         'Set swSubFeat = swFeat.GetFirstSubFeature
    
34.         Set swDispDim = swFeat.GetFirstDisplayDimension
    : J% E, o# p7 p: t, X/ @
35.         Do While Not swDispDim Is Nothing
    * w) X$ ?* F: ^5 a9 r+ h
36.             'Set swAnn = swDispDim.GetAnnotation
    ' }( r( Z, P& p5 j6 Y8 N
37.             Set SwDim = swDispDim.GetDimension
    8 h- D4 p9 i# S  V# m' G$ E
38.             Str = SwDim.FullName '特徵樹名稱
    
39.             oArr = Split(Str, "@")
    
40.             Str = oArr(0) & "@" & oArr(1)
    5 V9 b2 F  C4 i0 m8 Z4 N+ k
41.             oDic(Str) = SwDim.GetSystemValue2("")
    
42.             Set swDispDim = swFeat.GetNextDisplayDimension(swDispDim)
    
43.             Debug.Print Str, oDic(Str) ', 符號相當於按Tab鍵
    
44.             kk = kk + 1
    
45.         Loop
    " Z1 f( p+ @: k
46.         Set swFeat = swFeat.GetNextFeature
    , {. R, b* T8 _  Q7 a7 T0 n
47.     Loop
    & ]( ~/ e( l$ R+ F: ]: m
48.     oArr1 = oDic.keys: oArr2 = oDic.Items
    + W+ e, P5 G' Z! p8 T) d' s
49.     .cells(1, 1) = "Serial number": .cells(1, 2) = "Array staging": .cells(1, 3) = "Dimension name"
    $ N6 }6 \# n8 T" T+ y
50.     .cells(1, 4) = "Feature name": .cells(1, 5) = "Dimension value"
    
51.     For kk = 2 To UBound(oArr1) + 2
    
52.         .cells(kk, 1) = kk - 2
    
53.         .cells(kk, 2) = "=" & """Arr(""" & " & " & .cells(kk, 1) & " & " & """)="""
    + x( T# ]* u; K0 k( ~; T
54.         .cells(kk, 3) = "'" & Chr(34) & oArr1(kk - 2) & Chr(34)
    8 @) |. Q" G7 J( T- S
55.         .cells(kk, 4) = Split(oArr1(kk - 2), "@")(1) '(1)僅讀取特徵名
    
56.         .cells(kk, 5) = oArr2(kk - 2)
    
57.     Next kk
    ; B& V  N& @0 Z% w  \& z) A2 m, U/ `
58. nn = .Range("C65536").End(3).Row 'End(3)==>End(xlUp)
    
59. Stop '暫停修改Excel之尺寸後,再按RUN執行鍵
    + n2 n/ D6 O2 w9 l; `$ X& C7 h
60. Set Part = SwApp.ActiveDoc
    
61. '依據Excel變動值修改到sw零件
    
62. For mm = 2 To nn
    1 ^6 b7 o  `$ o! V& v$ Q+ m, D% f3 G
63.     Size_name = Mid(.cells(mm, 3), 2, Len(.cells(mm, 3)) - 2)
    
64.     Part.Parameter(Size_name).SystemValue = .cells(mm, 5)
    " u- p( c* k+ Y6 I+ G
65. Next mm
    , c8 I7 A! V) u: t3 ]
66. End With
    ; Z9 S+ j$ W2 n" M2 f% J3 j* L
67. boolStatus = Part.EditRebuild3()
    
68. MsgBox "Part size modification ends" '零件尺寸修改結束
    ; @8 z5 a' L' N8 z" S& d& V- a- \) n
69. End Sub
    

复制代码

! \/ E' O7 ]7 d9 R3 T: F

2. 另也可以直接寫在 EXCEL
/ \8 f" `8 i/ v, K3 E

zmztx

. ]8 o6 ^  E7 a. P  w
( x' S! k( g( f: O6 [; _我没有去掉function的意思，反而觉得用一些function，sub，更好。容易读，容易改。不过自己用，自己觉得好就好
& s4 H' F8 C0 x. M( g$ P+ O7 `8 ?
“58.nn = .Range("C65536").End(3).Row
你这是Excel2003？
/ ~& n' o6 J- J5 P6 S从excel，SW的数据读进来，处理以后再写回去
以前在solidedge中，用过这种方式，发现一个问题，solidedge的数据有一个半角字符，写到excel中看不出来。费了不少时间
这事在sw中不知道有没有