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

zmztx

ryouss 發(fā)表于 2019-7-6 11:50
  P, W5 e$ Q) R; L8 H2 C8 @0 {- |什麼版本測試的,顯示什麼錯誤提示?

' L# Q4 v: m2 R2 E: u/ ^# f& cSW2016,，還沒有裝好
剛開始,，看到最上面的代碼

• 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,，這樣就不行了,。
+ t4 D6 ~( z5 y& f0 O如果是Function SetSwPart() as object就更清楚了,，當然這么些也沒錯,，就是內(nèi)存多占了一點
3 s8 B1 E* T/ E' ]# r" ?2 o這段相當于對象指針設(shè)置,，對吧
* V4 i( q" V; u
如果“在EXCEL修改尺寸”，還有一種辦法,，用DDE,，就是在excel中修改參數(shù)后，WS中自動就改過來了
DDE現(xiàn)在似乎只是用在excel中,，其他地方不常見了
4 r4 d& W$ [* e' _8 D8 _9 v

ryouss

zmztx 發(fā)表于 2019-7-8 14:48
/ {; O! `* |, |! S/ \4 q6 `SW2016,，還沒有裝好
剛開始，看到最上面的代碼

難得zmztx大大能深入探討很不錯.
/ ]/ b. @& m& b6 H" a7 ?4 U. C
1. 是可以簡化去掉 Function SetSwPart()

1. '~~~~~~~~~~~~~~~~~~ 2019/07/06 V19070601 ~~~
   
2. ' 操作:
   ( P9 H5 b$ i# a* F# C7 W
3. '   1. 開 EXCEL文件.
   7 {( \# n. W  _  e/ a! L
4. '   2. 開 SW零件.
   9 X; s3 V) s/ Y( e' z* _
5. '   3. 執(zhí)行 ReadSwDimensionInSldPrt().
   2 C3 w, O; i4 m" H( U
6. '   4. 在EXCEL修改尺寸.
   8 ~, [8 x9 u# A! x1 q; z
7. '
   , u; S9 k$ ^3 H- `
8. ' 功能:
     D+ T0 O( p* ~2 w
9. '   1. 讀取SW零件的全部尺寸,寫到 Excel.
   ' v2 w2 u' Z" |1 j
10. '   2. 在Excel變動尺寸后,修改SW的零件尺寸.
    ! o/ U/ \" c3 r7 R( X
11. '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    0 `- L9 \0 T/ ~
12. 
    
13.   Dim SwApp As Object
    ! a; q2 r, O# M* C5 ]/ s8 b' x. F
14.   Dim boolStatus As Boolean
    
15.   Dim swFeat As Object ', swSubFeat As Object
    
16.   Dim swDispDim As Object, SwDim As Object
    
17.   Dim Str
    ) Y) M2 w& o6 ]- s: U: s" y2 ^; S' f
18.   Dim oDic
    
19.   Dim oArr1, oArr2
    3 W0 ^$ }; |. {& z8 j0 j
20.   
    / k+ N8 |. _0 x% s2 o
21. Sub ReadSwDimensionInSldPrt()
    ( d% F+ C# o" ~  G, F; e$ y
22.   '讀取SW的全部尺寸
    . b6 O# e0 p( f( o/ L
23.     Set SwApp = Application.SldWorks
    
24.     Set Part = SwApp.ActiveDoc
    1 P! ^; m5 a) _$ ^2 s0 R, V. ^
25.     Set oDic = CreateObject("Scripting.Dictionary")
    7 n/ b9 g5 g0 I! @4 V2 V
26. '*** Get active sheet in Excel
    # D8 l1 M1 ^+ l2 w
27.     Set xl = GetObject(, "Excel.Application")
    
28. With xl.ActiveSheet
    
29.     Set swFeat = Part.FirstFeature
    
30.     kk = 1
    8 ]7 c- X. h- k
31.     Do While Not swFeat Is Nothing
    : c1 ?6 \8 z4 k) ^: D
32.         Debug.Print "  " + swFeat.Name
    
33.         'Set swSubFeat = swFeat.GetFirstSubFeature
    & k5 j  d3 ~( G( h
34.         Set swDispDim = swFeat.GetFirstDisplayDimension
    " d8 _, D/ k+ o5 w* t0 s5 L2 I2 @
35.         Do While Not swDispDim Is Nothing
    % R4 a2 R+ u& O8 S
36.             'Set swAnn = swDispDim.GetAnnotation
    
37.             Set SwDim = swDispDim.GetDimension
    
38.             Str = SwDim.FullName '特徵樹名稱
    
39.             oArr = Split(Str, "@")
    . r* b8 ^. P0 f9 Y& J  [% r
40.             Str = oArr(0) & "@" & oArr(1)
    2 J6 |4 s9 f$ ~
41.             oDic(Str) = SwDim.GetSystemValue2("")
    " E5 ^& S3 w* g9 o' C# c% S
42.             Set swDispDim = swFeat.GetNextDisplayDimension(swDispDim)
    . o3 F$ H% w9 k
43.             Debug.Print Str, oDic(Str) ', 符號相當於按Tab鍵
    * f) y. a0 ~+ Z9 \- G9 t
44.             kk = kk + 1
    5 I7 c9 _5 }9 P! m
45.         Loop
    
46.         Set swFeat = swFeat.GetNextFeature
    
47.     Loop
    ; c7 q. _+ d/ s' V
48.     oArr1 = oDic.keys: oArr2 = oDic.Items
    
49.     .cells(1, 1) = "Serial number": .cells(1, 2) = "Array staging": .cells(1, 3) = "Dimension name"
    & z7 U* |* P" q* x1 I- ?
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
    . I8 j- I+ r5 Q& [4 C8 S
53.         .cells(kk, 2) = "=" & """Arr(""" & " & " & .cells(kk, 1) & " & " & """)="""
    9 z( f8 U: c' [* n: Q* Q
54.         .cells(kk, 3) = "'" & Chr(34) & oArr1(kk - 2) & Chr(34)
    ) X* O* _; l) P# H" q3 P
55.         .cells(kk, 4) = Split(oArr1(kk - 2), "@")(1) '(1)僅讀取特徵名
    6 e; A  e* C, l
56.         .cells(kk, 5) = oArr2(kk - 2)
    + J2 U5 H# c6 A8 J0 j5 r
57.     Next kk
    6 h0 P" S" S4 G
58. nn = .Range("C65536").End(3).Row 'End(3)==>End(xlUp)
    
59. Stop '暫停修改Excel之尺寸後,再按RUN執(zhí)行鍵
    
60. Set Part = SwApp.ActiveDoc
    ( V2 c$ W" u; n' \
61. '依據(jù)Excel變動值修改到sw零件
    
62. For mm = 2 To nn
    2 k% t1 N( a) u0 p0 l
63.     Size_name = Mid(.cells(mm, 3), 2, Len(.cells(mm, 3)) - 2)
    
64.     Part.Parameter(Size_name).SystemValue = .cells(mm, 5)
    
65. Next mm
    
66. End With
    $ R! d2 U" k3 B" @% T# Z' y! q
67. boolStatus = Part.EditRebuild3()
    
68. MsgBox "Part size modification ends" '零件尺寸修改結(jié)束
    - z6 @8 Z; p  Y! x5 H
69. End Sub
    / o  Q: \# }& L

復(fù)制代碼

8 \. o0 K# F6 ^$ T9 S: E
0 w  b3 e  t$ {, t3 ]8 u  _+ c+ @2. 另也可以直接寫在 EXCEL


4 Q, t, z; X6 S+ x8 i% d  p

zmztx

9 i. v4 S' e* ^! R/ W& U9 U% D+ K
  @7 M: f% I  R, R/ B我沒有去掉function的意思,，反而覺得用一些function，sub,，更好,。容易讀，容易改,。不過自己用,，自己覺得好就好
$ r+ ]# h! g# G# N, s- g4 l" }# K
. Y! D. |* \; j- Z" p4 e. Z, W“58.nn = .Range("C65536").End(3).Row
+ @! Z* k6 u" C4 `& g2 ^你這是Excel2003？
從excel,，SW的數(shù)據(jù)讀進來,，處理以后再寫回去
以前在solidedge中，用過這種方式,，發(fā)現(xiàn)一個問題,，solidedge的數(shù)據(jù)有一個半角字符，寫到excel中看不出來,。費了不少時間
這事在sw中不知道有沒有
, s4 e; y: ]$ X. g7 i6 ?4 Z! h