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

ryouss

參考
9 O$ \! J4 I/ U8 I5 [

1 C1 f9 F- i" z% m! Y# z
' b' k/ M7 G: N
. s5 c8 C. B6 m% r, n# z- T; {1 H; X, Q


! K! R- L- n, T1 P2 n* R2 h% m) \

1. '~~~~~~~~~~~~~~~~ 2019/07/04 ~~~~~~~~~~~~~~~~
   . S0 ^9 n4 l. u# X8 d* n* f' {
2. ' 操作:
   
3. '   1. 開 EXCEL文件.
   
4. '   2. 開 SW零件.
   
5. '   3. 執行 ReadSwDimensionInSldPrt().
   
6. '   4. 在EXCEL修改尺寸.
   
7. '
   5 r" {1 [" c. x9 c& h, ^- A
8. ' 功能:
   
9. '   1. 讀取SW零件的全部尺寸,寫到 Excel.
   . R2 y6 w5 F9 F8 U
10. '   2. 在Excel變動尺寸后,修改SW的零件尺寸.
    + t( \# g4 J/ M1 m
11. '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    " ?' I. e0 V2 q/ u# ^# _
12. Function SetSwPart()
    6 ]! h- S4 h# i# }/ w
13.   Dim SwApp As Object
    - t. ], b* r6 c5 f  h
14.   Dim SelMgr As Object, boolStatus As Boolean
    + Y" |- w# E8 H4 L. H7 _! }  P
15.   Dim longstatus As Long, longwarnings As Long
    - `* T& }& e3 v2 \! X# |
16.   Set SwApp = GetObject(, "sldworks.application")
    
17.   Set SetSwPart = SwApp.ActiveDoc
      [# W5 v5 |  A# {' `7 x0 d
18. End Function
    
19. '****************************
    
20. Private Sub ReadSwDimensionInSldPrt()
    
21.   '讀取SW的全部尺寸
    
22.   Dim oDic
    
23.   Set oDic = CreateObject("Scripting.Dictionary")
    
24. '*** Get active sheet in Excel
    
25.   Set xl = GetObject(, "Excel.Application")
    
26.   Set xls = xl.ActiveSheet
    ; D1 N  b, j/ b
27. With xls
    6 f, q" h- |  h; B
28.     Dim swFeat As Object, swSubFeat As Object
    
29.     Dim swDispDim As Object, SwDim As Object
    0 b8 M, W5 E' A' q3 w
30.     Dim swAnn As Object
    $ b8 Z1 Z' o  O. [6 S, h
31.     Dim bRet As Boolean
    1 @$ T3 o/ e" y3 Z7 n: j) z% [
32.     Dim Str
    % h4 g0 o9 L) n3 j2 A8 p
33.     Set SwApp = CreateObject("SldWorks.Application")
    1 {  r: m7 U# |
34.     Set SwPart = SetSwPart
    & I4 T, S. |6 k1 o" l2 v
35.     Set swFeat = SwPart.FirstFeature
    4 m3 B( m/ z" }2 Q5 D
36.     kk = 1
    # A& u" f$ Z* ]  |6 O2 o9 ^9 K2 X
37.     Do While Not swFeat Is Nothing
    , P" [( Q0 g2 B$ o, g1 n
38.         Debug.Print "  " + swFeat.Name
    & C8 I5 ], K, `
39.         Set swSubFeat = swFeat.GetFirstSubFeature
    
40.         Set swDispDim = swFeat.GetFirstDisplayDimension
    1 @% ~9 R  S1 {4 n
41.         Do While Not swDispDim Is Nothing
    
42.             Set swAnn = swDispDim.GetAnnotation
    
43.             Set SwDim = swDispDim.GetDimension
    
44.             'Debug.Print "    [" & SwDim.FullName & "] = " & SwDim.GetSystemValue2("")
    , ?* K. @6 O0 T/ S. o- E
45.             Debug.Print SwDim.FullName, SwDim.GetSystemValue2("")
    , E% Z1 P7 U. o5 o
46.             Str = SwDim.FullName
    
47.             oArr = Split(Str, "@")
    
48.             Str = oArr(0) & "@" & oArr(1)
    
49.             oDic(Str) = SwDim.GetSystemValue2("")
    0 x9 `2 r, ~6 H
50.             Set swDispDim = swFeat.GetNextDisplayDimension(swDispDim)
    
51.         kk = kk + 1
    $ f. O( d1 }+ n' W* P
52.         Loop
    
53.         Set swFeat = swFeat.GetNextFeature
    + S0 j: q5 x9 t7 a1 z) n
54.     Loop
    # O5 V2 r  p1 [; ?8 H8 B  e2 o0 g
55.     Dim oArr1, oArr2
    / T. e) p9 @" o7 [3 Q# j5 ~; c
56.     oArr1 = oDic.keys: oArr2 = oDic.Items
    
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":
    / ]  n8 e9 }+ H- ?( n1 \
59.    
    
60.     For kk = 2 To UBound(oArr1) + 2
    0 v8 J1 J- N7 x' W% [3 f' [2 g
61.         .cells(kk, 1) = kk - 2
    ( |6 w3 \5 [" P; b9 v$ Y
62.         .cells(kk, 2) = "=" & """Arr(""" & " & " & .cells(kk, 1) & " & " & """)="""
    
63.         .cells(kk, 3) = "'" & Chr(34) & oArr1(kk - 2) & Chr(34)
    
64.         .cells(kk, 4) = Split(oArr1(kk - 2), "@")(1)
    & ?+ ^6 z4 @5 |
65.         .cells(kk, 5) = oArr2(kk - 2)
    
66.     Next kk
    / i, q1 h/ U  q7 T4 S# h
67. nn = .range("C65536").End(3).Row 'End(3)==>End(xlUp)
    
68. Stop '暫停修改Excel之尺寸後,再按RUN執行鍵
    
69. Set Part = SwApp.ActiveDoc
    
70. '依據Excel變動值修改到sw零件
    9 j- o* h% X% B6 L. A
71. For mm = 2 To nn
    
72.     Size_name = Mid(.cells(mm, 3), 2, Len(.cells(mm, 3)) - 2)
    
73.     Part.Parameter(Size_name).SystemValue = .cells(mm, 5)
    * Z# M+ C- i* ^2 x8 z+ p! F- a( x3 h
74. Next mm
    2 I  g% O% a& Q
75. End With
    ! ?5 u) \0 d  V  {( l9 I
76. boolStatus = Part.EditRebuild3()
    
77. MsgBox "Part size modification ends" '零件尺寸修改結束
    4 e$ G4 i  F+ ~" }0 t1 _. G
78. End Sub
    

复制代码

+ a  e# f& ~7 U+ @0 W8 _  |5 C

) \7 M& \0 {9 Y' }% l
' g, l* C0 S2 {3 U

零度freedom

想法很好SW和表格挂钩，不过这个改尺寸的，和SW的设计表有点类似

ィ心兂鎅

大神，三维网也发了吗？

未来第一站

zmztx

能给出注释吗？
1 w: W0 i2 O: @, v5 I怎么看上去运行不起来，或者不是全部代码？

ryouss

9 A1 O- K8 @. F
Private Sub ReadSwDimensionInSldPrt()

1. 執行如上編程,鼠標須放在如上之下.再按"RUN"執行鍵.
1 n: ^9 r8 O: x3 |% Z2. 在SW2012,2017測試正常.


' a, [' V7 H( E$ Y

ryouss

zmztx 发表于 2019-7-5 09:57
( J$ A  B9 h/ N% {, s, {8 s能给出注释吗？
怎么看上去运行不起来，或者不是全部代码？

SW2017測試OK(有圖可證)

! F/ E  k: l0 \  n

zmztx

ryouss 发表于 2019-7-5 11:11
2 W+ W* M( y5 s0 |SW2017測試OK(有圖可證)

谢谢，我再仔细琢磨
9 x" N; m2 {- }# _; }2 l最上面的function似乎有点不对

ryouss

zmztx 发表于 2019-7-5 16:15
谢谢，我再仔细琢磨
* Q* g) t9 E$ V1 p3 o, `最上面的function似乎有点不对

# t$ [' Z' c4 @0 K+ V1 M什麼版本測試的,顯示什麼錯誤提示?

远祥

这是神马啊？