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

ryouss

參考
) Z/ j! f5 z% z* i# k- |
; a* s/ }6 }1 S; \7 R9 T) a





6 {' q9 K2 z, M4 Q

1. '~~~~~~~~~~~~~~~~ 2019/07/04 ~~~~~~~~~~~~~~~~
   
2. ' 操作:
   
3. '   1. 開 EXCEL文件.
   
4. '   2. 開 SW零件.
   , E* ?! y7 G' O" ~8 K
5. '   3. 執行 ReadSwDimensionInSldPrt().
   
6. '   4. 在EXCEL修改尺寸.
   
7. '
   
8. ' 功能:
   5 P' u! A6 i$ d2 H5 Z
9. '   1. 讀取SW零件的全部尺寸,寫到 Excel.
   
10. '   2. 在Excel變動尺寸后,修改SW的零件尺寸.
    
11. '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    + R( N, s3 p0 K$ e% E! F3 H" ]
12. Function SetSwPart()
    
13.   Dim SwApp As Object
    
14.   Dim SelMgr As Object, boolStatus As Boolean
    
15.   Dim longstatus As Long, longwarnings As Long
    7 M( r) M+ F' D( Z: u% h# D
16.   Set SwApp = GetObject(, "sldworks.application")
    0 ~6 U, c6 @7 r: I+ L
17.   Set SetSwPart = SwApp.ActiveDoc
    9 A! P( H) B. G/ m2 j
18. End Function
    
19. '****************************
    
20. Private Sub ReadSwDimensionInSldPrt()
    
21.   '讀取SW的全部尺寸
    
22.   Dim oDic
    
23.   Set oDic = CreateObject("Scripting.Dictionary")
    ( |5 }% E8 a  R3 [0 i9 m# k
24. '*** Get active sheet in Excel
    
25.   Set xl = GetObject(, "Excel.Application")
    
26.   Set xls = xl.ActiveSheet
    3 ?. m. f% H: N/ r' g( p$ W, l
27. With xls
    % P5 ~8 _% T, G0 z
28.     Dim swFeat As Object, swSubFeat As Object
    7 U% [/ v2 @) O1 I7 I
29.     Dim swDispDim As Object, SwDim As Object
    : m. I* k1 Z7 z/ Z5 u# z  `+ _" l. F
30.     Dim swAnn As Object
    
31.     Dim bRet As Boolean
    - N) \7 `7 X" y. S, }
32.     Dim Str
    2 |, D. n2 @9 K, B3 D
33.     Set SwApp = CreateObject("SldWorks.Application")
    
34.     Set SwPart = SetSwPart
    3 h6 V! B! M2 B7 t% ^' C0 n4 i
35.     Set swFeat = SwPart.FirstFeature
    , f1 }" S0 J9 B6 O+ |
36.     kk = 1
    , [' B1 S4 K6 E4 C
37.     Do While Not swFeat Is Nothing
    4 s( H5 D, U0 p
38.         Debug.Print "  " + swFeat.Name
    7 K/ v0 I7 R9 y
39.         Set swSubFeat = swFeat.GetFirstSubFeature
    
40.         Set swDispDim = swFeat.GetFirstDisplayDimension
    9 Z% h  y3 @# J7 ]
41.         Do While Not swDispDim Is Nothing
    
42.             Set swAnn = swDispDim.GetAnnotation
    7 F. Z2 B" g, J* E; n+ S* a5 |
43.             Set SwDim = swDispDim.GetDimension
    
44.             'Debug.Print "    [" & SwDim.FullName & "] = " & SwDim.GetSystemValue2("")
    " z( }1 u6 ^* C/ P- s  g
45.             Debug.Print SwDim.FullName, SwDim.GetSystemValue2("")
    
46.             Str = SwDim.FullName
    ! X0 J- e6 X* v1 k
47.             oArr = Split(Str, "@")
    
48.             Str = oArr(0) & "@" & oArr(1)
    # @# C) D# R& a2 t  u4 ~8 i
49.             oDic(Str) = SwDim.GetSystemValue2("")
    
50.             Set swDispDim = swFeat.GetNextDisplayDimension(swDispDim)
    ) t/ N- j4 M' h1 E- v/ \
51.         kk = kk + 1
    
52.         Loop
    
53.         Set swFeat = swFeat.GetNextFeature
    6 V1 i9 x2 ^! Q1 b# P
54.     Loop
    : L6 B9 |2 g% T( D
55.     Dim oArr1, oArr2
    
56.     oArr1 = oDic.keys: oArr2 = oDic.Items
      [2 R' |+ [( R- f
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":
    ! T& t8 H- P0 n' b  \
59.    
    
60.     For kk = 2 To UBound(oArr1) + 2
    
61.         .cells(kk, 1) = kk - 2
    
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)
    
65.         .cells(kk, 5) = oArr2(kk - 2)
    . ~' x3 h6 Y7 e" [; P  w* r! u- s7 T3 i
66.     Next kk
    7 n1 F$ O& f2 d6 T9 q
67. nn = .range("C65536").End(3).Row 'End(3)==>End(xlUp)
    
68. Stop '暫停修改Excel之尺寸後,再按RUN執行鍵
    3 t- _4 f1 i: J% z) G' ?
69. Set Part = SwApp.ActiveDoc
    % `0 m, E9 g; h
70. '依據Excel變動值修改到sw零件
    3 H: N  f( ^9 N% |; m$ N0 k% o
71. For mm = 2 To nn
    7 G% `' ?$ V' U$ t8 d2 [
72.     Size_name = Mid(.cells(mm, 3), 2, Len(.cells(mm, 3)) - 2)
    $ Z1 v# p1 x5 n% }/ n, k; k
73.     Part.Parameter(Size_name).SystemValue = .cells(mm, 5)
    
74. Next mm
    ! N% U( e3 e- G- `
75. End With
    
76. boolStatus = Part.EditRebuild3()
    ' z1 W( s: u  v
77. MsgBox "Part size modification ends" '零件尺寸修改結束
    ( ^/ I: o& ^6 x+ _' p
78. End Sub
    

复制代码

* F( E. C* P" c0 _8 M7 X, ~4 r3 @

零度freedom

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

ィ心兂鎅

大神，三维网也发了吗？

未来第一站

zmztx

能给出注释吗？
怎么看上去运行不起来，或者不是全部代码？

ryouss

Private Sub ReadSwDimensionInSldPrt()

1. 執行如上編程,鼠標須放在如上之下.再按"RUN"執行鍵.
2. 在SW2012,2017測試正常.

) s; \: D8 Q3 F1 `" ]

ryouss

zmztx 发表于 2019-7-5 09:57
能给出注释吗？
怎么看上去运行不起来，或者不是全部代码？

) L7 s( s+ _- LSW2017測試OK(有圖可證)
0 H& e- k; r& h9 V1 l) d

. N. d! z+ U8 o. a, i1 P+ u/ f
8 M9 N5 H  E4 l' h

zmztx

ryouss 发表于 2019-7-5 11:11
SW2017測試OK(有圖可證)

谢谢，我再仔细琢磨
) n2 c0 o* }+ V7 y# v最上面的function似乎有点不对
% Z' g& {) z3 {

ryouss

zmztx 发表于 2019-7-5 16:15
谢谢，我再仔细琢磨
( Y9 {' L# `3 G7 o3 M. G最上面的function似乎有点不对

6 p1 U1 R4 S. c- _2 F# H什麼版本測試的,顯示什麼錯誤提示?
5 _! I- k5 U+ I9 m) W7 J

远祥

这是神马啊？