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

ryouss

參考


. d5 L$ e: ^$ }" w
# y/ ?8 P4 l; V$ U7 B6 {" {

1. '~~~~~~~~~~~~~~~~ 2019/07/04 ~~~~~~~~~~~~~~~~
   
2. ' 操作:
   8 R! ]0 C& G/ @# b
3. '   1. 開 EXCEL文件.
   
4. '   2. 開 SW零件.
   
5. '   3. 執行 ReadSwDimensionInSldPrt().
   
6. '   4. 在EXCEL修改尺寸.
   3 W9 e/ S3 q$ D0 v
7. '
   
8. ' 功能:
   
9. '   1. 讀取SW零件的全部尺寸,寫到 Excel.
     I7 o: d3 s- O# w
10. '   2. 在Excel變動尺寸后,修改SW的零件尺寸.
    - I: F% L$ X! u/ O  S
11. '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    
12. Function SetSwPart()
    + l) T- g9 j- g, @$ J3 o+ L  M
13.   Dim SwApp As Object
    
14.   Dim SelMgr As Object, boolStatus As Boolean
    
15.   Dim longstatus As Long, longwarnings As Long
    
16.   Set SwApp = GetObject(, "sldworks.application")
    
17.   Set SetSwPart = SwApp.ActiveDoc
    
18. End Function
    - @9 {" ~+ E& X7 o" q
19. '****************************
    0 c1 j  p$ M6 |5 f+ Q& A$ \$ t5 M( o
20. Private Sub ReadSwDimensionInSldPrt()
    8 a4 @3 C+ V5 ~+ {$ S
21.   '讀取SW的全部尺寸
      v0 D4 Z8 ?, E, O3 r
22.   Dim oDic
    
23.   Set oDic = CreateObject("Scripting.Dictionary")
    # r4 \( c+ I# T/ u# F  k  n: f
24. '*** Get active sheet in Excel
    ; R5 {& q1 `& S+ C! n* `8 q3 ?
25.   Set xl = GetObject(, "Excel.Application")
    + |" L7 h0 r3 v9 C1 s& b* c
26.   Set xls = xl.ActiveSheet
    
27. With xls
    3 ?( v- c7 \& G9 L" u  }+ k4 ]" X
28.     Dim swFeat As Object, swSubFeat As Object
    , h* Q! c& X3 Y$ p! |
29.     Dim swDispDim As Object, SwDim As Object
    # X2 A6 b; R* L/ v% c! J) i
30.     Dim swAnn As Object
    
31.     Dim bRet As Boolean
    ' X( B. _  d4 y
32.     Dim Str
    
33.     Set SwApp = CreateObject("SldWorks.Application")
    , }4 v+ S0 t! l- h) U
34.     Set SwPart = SetSwPart
    8 w; r/ H: C8 W1 Q, e; _8 p
35.     Set swFeat = SwPart.FirstFeature
    
36.     kk = 1
    
37.     Do While Not swFeat Is Nothing
    
38.         Debug.Print "  " + swFeat.Name
    0 w% ^1 s$ U& P8 V. H( `& N# v
39.         Set swSubFeat = swFeat.GetFirstSubFeature
    4 ]5 @& V6 G- Z9 [# B
40.         Set swDispDim = swFeat.GetFirstDisplayDimension
    $ T1 J. r- P) `" _; y2 ~  r+ {# j
41.         Do While Not swDispDim Is Nothing
    
42.             Set swAnn = swDispDim.GetAnnotation
    ( c. F, r# `: e
43.             Set SwDim = swDispDim.GetDimension
    ) F8 ]3 h# A" M- A9 f7 y
44.             'Debug.Print "    [" & SwDim.FullName & "] = " & SwDim.GetSystemValue2("")
    " p- l+ P3 P* O! H' F
45.             Debug.Print SwDim.FullName, SwDim.GetSystemValue2("")
    ; @" M# j/ ]3 }* B! f' u/ I
46.             Str = SwDim.FullName
    
47.             oArr = Split(Str, "@")
    
48.             Str = oArr(0) & "@" & oArr(1)
    ) c1 `8 |. S6 K( K
49.             oDic(Str) = SwDim.GetSystemValue2("")
    ! n7 ~; J- O0 B
50.             Set swDispDim = swFeat.GetNextDisplayDimension(swDispDim)
    
51.         kk = kk + 1
    1 Z% H' v/ u) R4 w. u
52.         Loop
    
53.         Set swFeat = swFeat.GetNextFeature
    1 [$ e3 H% A$ A. @6 Y
54.     Loop
    + d( E8 V2 E/ l) C% B' p* a
55.     Dim oArr1, oArr2
    
56.     oArr1 = oDic.keys: oArr2 = oDic.Items
    9 u1 {* ?( G) I% e3 P6 r3 A0 i: G
57.     .cells(1, 1) = "Serial number": .cells(1, 2) = "Array staging": .cells(1, 3) = "Dimension name"
    
58.     .cells(1, 4) = "Feature name": .cells(1, 5) = "Dimension value":
    
59.    
    ; g, y* j5 Y% M2 |$ {* g
60.     For kk = 2 To UBound(oArr1) + 2
    
61.         .cells(kk, 1) = kk - 2
    1 o6 \9 P& g' y. k2 T( x
62.         .cells(kk, 2) = "=" & """Arr(""" & " & " & .cells(kk, 1) & " & " & """)="""
    
63.         .cells(kk, 3) = "'" & Chr(34) & oArr1(kk - 2) & Chr(34)
    # V, q5 b2 B* W# `2 }
64.         .cells(kk, 4) = Split(oArr1(kk - 2), "@")(1)
    
65.         .cells(kk, 5) = oArr2(kk - 2)
    
66.     Next kk
    
67. nn = .range("C65536").End(3).Row 'End(3)==>End(xlUp)
    
68. Stop '暫停修改Excel之尺寸後,再按RUN執行鍵
    " f0 j2 K& f9 P3 Z5 n, x5 i
69. Set Part = SwApp.ActiveDoc
    
70. '依據Excel變動值修改到sw零件
    
71. For mm = 2 To nn
    & ~* c5 W) E3 J2 k3 C
72.     Size_name = Mid(.cells(mm, 3), 2, Len(.cells(mm, 3)) - 2)
    : b6 m% B3 c0 ^% i
73.     Part.Parameter(Size_name).SystemValue = .cells(mm, 5)
    2 ?8 m' B* [! r/ V2 M6 @
74. Next mm
    0 Z" U  A" N. `  ]4 K6 s
75. End With
    
76. boolStatus = Part.EditRebuild3()
    ' a( T9 @0 n( D7 r
77. MsgBox "Part size modification ends" '零件尺寸修改結束
    * R7 z# E+ E4 `$ F
78. End Sub
    ! G4 Y& M3 f: i( C+ d& B

復制代碼

/ g9 N, Z7 G$ S9 l


5 }8 r# e) ^7 v. {" s( J- |

3 H- _4 V# c5 v+ @) @/ p

零度freedom

想法很好SW和表格掛鉤，不過這個改尺寸的，和SW的設計表有點類似

ィ心兂鎅

大神，三維網也發了嗎？

未來第一站

zmztx

能給出注釋嗎？
怎么看上去運行不起來，或者不是全部代碼？

ryouss

. T% K/ C' A4 g3 V# W) u1 S' Q/ {
# F6 N! z* O/ o" @, `Private Sub ReadSwDimensionInSldPrt()
0 P0 G8 X+ ^1 |- F, m" Q
1. 執行如上編程,鼠標須放在如上之下.再按"RUN"執行鍵.
$ n- Z4 c' y9 P; V( G2. 在SW2012,2017測試正常.
- g- F- n. q, P* b$ r( {1 A$ ~

ryouss

zmztx 發表于 2019-7-5 09:57
能給出注釋嗎？
+ l0 ?; C& X4 V: v) H3 z怎么看上去運行不起來，或者不是全部代碼？

5 \" T' K2 I1 `2 f6 }. ZSW2017測試OK(有圖可證)
5 L, x1 r6 x+ O1 @' w
' }& X& ?$ |0 t6 V* }. y

; I5 a' r; ?( O1 [0 x" p/ |

zmztx

ryouss 發表于 2019-7-5 11:11
' |, p2 [) u% h& x0 d, BSW2017測試OK(有圖可證)

謝謝，我再仔細琢磨
) b0 D5 V8 a$ H3 A- P- J4 d最上面的function似乎有點不對
* o! D* s: x0 o

ryouss

zmztx 發表于 2019-7-5 16:15
謝謝，我再仔細琢磨
$ i% {1 w' \6 D最上面的function似乎有點不對

什麼版本測試的,顯示什麼錯誤提示?
9 S6 Q& c7 \0 C

遠祥

這是神馬啊？