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

zmztx

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

$ d' _2 t: [) {/ rSW2016，还没有装好
刚开始，看到最上面的代码

• 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，这样就不行了。
  ]$ `, q) s* ^0 s; I如果是Function SetSwPart() as object就更清楚了，当然这么些也没错，就是内存多占了一点
这段相当于对象指针设置，对吧

如果“在EXCEL修改尺寸”，还有一种办法，用DDE，就是在excel中修改参数后，WS中自动就改过来了
. o+ w, @4 [* c0 U6 ^4 H7 uDDE现在似乎只是用在excel中，其他地方不常见了
: `0 [4 x0 k! x& s& M/ k
% D& R  v# R7 y

ryouss

zmztx 发表于 2019-7-8 14:48
SW2016，还没有装好
8 u$ E8 O- s0 q, f7 O刚开始，看到最上面的代码

難得zmztx大大能深入探討很不錯.
! G5 t8 |2 \6 e% D- r' @
1. 是可以簡化去掉 Function SetSwPart()

1. '~~~~~~~~~~~~~~~~~~ 2019/07/06 V19070601 ~~~
   * G# r& L. g: {0 N# C% I+ C3 q8 L
2. ' 操作:
   
3. '   1. 開 EXCEL文件.
   + s) Q# e. F. ~, p
4. '   2. 開 SW零件.
   ( M- P- A$ O! X4 y4 j- h2 z
5. '   3. 執行 ReadSwDimensionInSldPrt().
   ; P' ?. u, d* y
6. '   4. 在EXCEL修改尺寸.
   ' G$ ?, b, B1 ]9 \
7. '
   
8. ' 功能:
   
9. '   1. 讀取SW零件的全部尺寸,寫到 Excel.
   1 {- k* ?1 o0 m
10. '   2. 在Excel變動尺寸后,修改SW的零件尺寸.
    ( L% w; h9 h: ?3 W3 L! y' O# R: F
11. '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    6 G3 c) S& `; T1 ~" {
12. 
    & c2 V9 g: k; w7 a2 W/ c7 `
13.   Dim SwApp As Object
    
14.   Dim boolStatus As Boolean
    1 K) {9 }9 ~" N4 u& b6 K
15.   Dim swFeat As Object ', swSubFeat As Object
    
16.   Dim swDispDim As Object, SwDim As Object
    + O. N% K$ L: H; |( G
17.   Dim Str
    
18.   Dim oDic
    ) a! R1 g. k: J3 Y% t+ C
19.   Dim oArr1, oArr2
    
20.   
    * B4 d6 q& _, P- x
21. Sub ReadSwDimensionInSldPrt()
    5 |! x! W! Z. h: ?0 D* n# V; e+ p
22.   '讀取SW的全部尺寸
    
23.     Set SwApp = Application.SldWorks
    0 f) o" D" l3 L3 ?% J; v+ \
24.     Set Part = SwApp.ActiveDoc
    
25.     Set oDic = CreateObject("Scripting.Dictionary")
    * {* Z6 T4 P' h- f) T- U8 ^
26. '*** Get active sheet in Excel
    ; A8 Z$ d9 I$ D! S) t
27.     Set xl = GetObject(, "Excel.Application")
    8 u5 U- e) I& X  `5 c
28. With xl.ActiveSheet
    ; }$ `. d6 O5 y  X
29.     Set swFeat = Part.FirstFeature
    
30.     kk = 1
    
31.     Do While Not swFeat Is Nothing
    
32.         Debug.Print "  " + swFeat.Name
    2 |& o; m' f$ s/ s2 [& D
33.         'Set swSubFeat = swFeat.GetFirstSubFeature
    . T& O8 D* Z' k; L( z( v
34.         Set swDispDim = swFeat.GetFirstDisplayDimension
    7 O  x$ z. O3 b4 k
35.         Do While Not swDispDim Is Nothing
    & f: l( k6 s0 A; r- q
36.             'Set swAnn = swDispDim.GetAnnotation
    / ?  _/ ]  U* F5 j  W: N5 {3 ~
37.             Set SwDim = swDispDim.GetDimension
    
38.             Str = SwDim.FullName '特徵樹名稱
    
39.             oArr = Split(Str, "@")
    
40.             Str = oArr(0) & "@" & oArr(1)
    $ V( i& @( R. b6 i1 y4 a
41.             oDic(Str) = SwDim.GetSystemValue2("")
    / }$ {' d, E7 F/ f
42.             Set swDispDim = swFeat.GetNextDisplayDimension(swDispDim)
    ' r3 ]9 s+ A% H! \8 w
43.             Debug.Print Str, oDic(Str) ', 符號相當於按Tab鍵
    8 h) H( I/ S# u! ?
44.             kk = kk + 1
    ( P+ b5 s9 `5 x% ]& V
45.         Loop
    # S/ C1 V# V, v" X: I+ F$ L; W2 {
46.         Set swFeat = swFeat.GetNextFeature
    9 o8 a' X( d3 j7 z. N
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"
    . C' k! y; T  ~2 [- c8 p- ]
50.     .cells(1, 4) = "Feature name": .cells(1, 5) = "Dimension value"
    
51.     For kk = 2 To UBound(oArr1) + 2
    + B: F# R1 S8 m2 H( `) w) |
52.         .cells(kk, 1) = kk - 2
    ) |, ^! v0 k1 P( O
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)
    ( O9 I3 o; i* N3 P( `
57.     Next kk
    
58. nn = .Range("C65536").End(3).Row 'End(3)==>End(xlUp)
    
59. Stop '暫停修改Excel之尺寸後,再按RUN執行鍵
    
60. Set Part = SwApp.ActiveDoc
    
61. '依據Excel變動值修改到sw零件
    
62. For mm = 2 To nn
    ; z# |4 q2 V5 [7 _+ ?
63.     Size_name = Mid(.cells(mm, 3), 2, Len(.cells(mm, 3)) - 2)
    4 X4 W& ^- _' z1 g
64.     Part.Parameter(Size_name).SystemValue = .cells(mm, 5)
    
65. Next mm
    
66. End With
    
67. boolStatus = Part.EditRebuild3()
    % ^+ [. T4 L$ e+ [1 V, _
68. MsgBox "Part size modification ends" '零件尺寸修改結束
    
69. End Sub
    5 I! M9 V, h) ]2 E$ n) O

复制代码

( G0 R" T2 c* b4 O, q8 p
) C( p  Q: a6 B. K
: q* F6 J. f$ d( m, i( o( O2. 另也可以直接寫在 EXCEL
' W  x. }0 ~: o3 c; B- ?

zmztx

/ `' z6 |' G; g% X8 d8 }/ r
我没有去掉function的意思，反而觉得用一些function，sub，更好。容易读，容易改。不过自己用，自己觉得好就好
. j% w$ K0 R- M! O0 w2 a+ P+ _
. I: c* D9 D% f  d; c/ {“58.nn = .Range("C65536").End(3).Row
你这是Excel2003？
3 W" ^9 w$ _% m5 @1 x4 A% `9 R% p从excel，SW的数据读进来，处理以后再写回去
! }$ U0 x# [) N以前在solidedge中，用过这种方式，发现一个问题，solidedge的数据有一个半角字符，写到excel中看不出来。费了不少时间
这事在sw中不知道有没有
, K8 w+ \7 R, }