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

zmztx

ryouss 发表于 2019-7-6 11:50
% r# Q5 t: R- P% U1 a) d" c什麼版本測試的,顯示什麼錯誤提示?

' L9 R  _' Z; r( V6 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，这样就不行了。
如果是Function SetSwPart() as object就更清楚了，当然这么些也没错，就是内存多占了一点
这段相当于对象指针设置，对吧

7 F. U1 C' Z3 i6 m如果“在EXCEL修改尺寸”，还有一种办法，用DDE，就是在excel中修改参数后，WS中自动就改过来了
( I% Z! V1 g/ j" B4 O( y  ^DDE现在似乎只是用在excel中，其他地方不常见了
- @* A: Y* v3 w. [
( V& O" F1 P3 g

ryouss

zmztx 发表于 2019-7-8 14:48
SW2016，还没有装好
2 X' F4 K2 i6 ]6 t- Q$ C; p' i刚开始，看到最上面的代码

5 x4 V% N! f7 w. D  j( e難得zmztx大大能深入探討很不錯.

# h4 d, C% r. r6 Y- K1. 是可以簡化去掉 Function SetSwPart()

& H- p# Z- v2 d9 G, _, M

1. '~~~~~~~~~~~~~~~~~~ 2019/07/06 V19070601 ~~~
   
2. ' 操作:
   1 |3 `4 O. {; f0 d0 `% \
3. '   1. 開 EXCEL文件.
   
4. '   2. 開 SW零件.
   
5. '   3. 執行 ReadSwDimensionInSldPrt().
     n- M6 ]" E: G0 n- V: O
6. '   4. 在EXCEL修改尺寸.
   8 [8 H5 W  h% t8 _) `
7. '
   
8. ' 功能:
   * G% J; H- w  z9 R9 F7 r  ]
9. '   1. 讀取SW零件的全部尺寸,寫到 Excel.
   3 N. Q3 V- T( M# L8 N
10. '   2. 在Excel變動尺寸后,修改SW的零件尺寸.
    8 R- o( v6 ]: H6 V) f+ @: ~
11. '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    
12. 
    
13.   Dim SwApp As Object
    ' R& j3 {6 j) _2 I* p7 H) t
14.   Dim boolStatus As Boolean
    $ l3 S( U8 ]- a
15.   Dim swFeat As Object ', swSubFeat As Object
    0 E, C9 P; p( b) k' {2 o0 g$ m& `
16.   Dim swDispDim As Object, SwDim As Object
    . W0 s* B0 K$ l; e/ @: @
17.   Dim Str
    
18.   Dim oDic
    ) s/ f% c( J) K4 T4 E# |# U6 x
19.   Dim oArr1, oArr2
    
20.   
    
21. Sub ReadSwDimensionInSldPrt()
    * i4 |0 ~: p; m  C$ x
22.   '讀取SW的全部尺寸
    # t( j# U8 ?# Q" f
23.     Set SwApp = Application.SldWorks
    
24.     Set Part = SwApp.ActiveDoc
    
25.     Set oDic = CreateObject("Scripting.Dictionary")
    
26. '*** Get active sheet in Excel
    ( c* o! B$ g, w( G
27.     Set xl = GetObject(, "Excel.Application")
    
28. With xl.ActiveSheet
    
29.     Set swFeat = Part.FirstFeature
    + q4 e1 H" C3 L4 C, E: R$ n
30.     kk = 1
    8 O8 P0 D0 ^' W
31.     Do While Not swFeat Is Nothing
    
32.         Debug.Print "  " + swFeat.Name
    
33.         'Set swSubFeat = swFeat.GetFirstSubFeature
    ' x) H" ~7 ]6 @7 W4 Q( `
34.         Set swDispDim = swFeat.GetFirstDisplayDimension
    
35.         Do While Not swDispDim Is Nothing
    
36.             'Set swAnn = swDispDim.GetAnnotation
    $ \7 U% C0 c6 s2 w. P* }
37.             Set SwDim = swDispDim.GetDimension
    
38.             Str = SwDim.FullName '特徵樹名稱
    
39.             oArr = Split(Str, "@")
    
40.             Str = oArr(0) & "@" & oArr(1)
    ) i- k# Z! E3 _" L# U* Z: }! C
41.             oDic(Str) = SwDim.GetSystemValue2("")
    - b' ?2 q2 v6 R5 Z% [  s, x
42.             Set swDispDim = swFeat.GetNextDisplayDimension(swDispDim)
    
43.             Debug.Print Str, oDic(Str) ', 符號相當於按Tab鍵
    0 D- q7 B: l5 t; @* B
44.             kk = kk + 1
    : }1 K2 u1 h2 b$ J
45.         Loop
    + A4 \% w* k% Q" V
46.         Set swFeat = swFeat.GetNextFeature
    
47.     Loop
    
48.     oArr1 = oDic.keys: oArr2 = oDic.Items
    1 z1 v! m' ]! K
49.     .cells(1, 1) = "Serial number": .cells(1, 2) = "Array staging": .cells(1, 3) = "Dimension name"
    
50.     .cells(1, 4) = "Feature name": .cells(1, 5) = "Dimension value"
    * `* S$ B3 t# X6 q6 h
51.     For kk = 2 To UBound(oArr1) + 2
    5 k* b7 j: K8 l0 b0 ]) I( I
52.         .cells(kk, 1) = kk - 2
    
53.         .cells(kk, 2) = "=" & """Arr(""" & " & " & .cells(kk, 1) & " & " & """)="""
    
54.         .cells(kk, 3) = "'" & Chr(34) & oArr1(kk - 2) & Chr(34)
    ! e+ E  U4 j$ H' x
55.         .cells(kk, 4) = Split(oArr1(kk - 2), "@")(1) '(1)僅讀取特徵名
    ; O4 \! \) Z' L0 a  k
56.         .cells(kk, 5) = oArr2(kk - 2)
    0 g7 s1 s. t& C+ \3 O+ U
57.     Next kk
    * \. o) k7 K* `: P/ e+ I
58. nn = .Range("C65536").End(3).Row 'End(3)==>End(xlUp)
    
59. Stop '暫停修改Excel之尺寸後,再按RUN執行鍵
    7 B; `4 L3 g3 {
60. Set Part = SwApp.ActiveDoc
    
61. '依據Excel變動值修改到sw零件
    9 b! o7 I; j2 n  L# k
62. For mm = 2 To nn
    
63.     Size_name = Mid(.cells(mm, 3), 2, Len(.cells(mm, 3)) - 2)
    ) O6 t5 G% {3 u
64.     Part.Parameter(Size_name).SystemValue = .cells(mm, 5)
    - O8 b, |: \; M- F
65. Next mm
    
66. End With
    . I. F! r3 P/ q
67. boolStatus = Part.EditRebuild3()
    " {8 M  i+ |- b- K4 K
68. MsgBox "Part size modification ends" '零件尺寸修改結束
    
69. End Sub
    

复制代码

9 }! r( c# \6 d
: N% d: j; }" [4 j- x. l0 I
/ Z& V8 B& |, m9 F' O* |2. 另也可以直接寫在 EXCEL

  T( v; F6 k7 H; z
+ \% k2 g7 S& J+ ~) f

zmztx

我没有去掉function的意思，反而觉得用一些function，sub，更好。容易读，容易改。不过自己用，自己觉得好就好
. a' m" r$ P/ r( B8 E3 E, E9 J7 m
“58.nn = .Range("C65536").End(3).Row
你这是Excel2003？
从excel，SW的数据读进来，处理以后再写回去
, [# q  Z9 u4 {* u! B1 s' M以前在solidedge中，用过这种方式，发现一个问题，solidedge的数据有一个半角字符，写到excel中看不出来。费了不少时间
9 z3 F! l+ w) H* u8 r8 F这事在sw中不知道有没有