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

zmztx

( ]8 x# y9 X* }% A1 b( w7 P- M

ryouss 发表于 2019-7-6 11:50
2 F) P' z% x3 x9 a& K( f1 p. M什麼版本測試的,顯示什麼錯誤提示?

SW2016，还没有装好
刚开始，看到最上面的代码

• 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
  % i  D: N/ `$ ^. M

把function看成了sub，这样就不行了。
/ ^9 Y- |6 |/ ~如果是Function SetSwPart() as object就更清楚了，当然这么些也没错，就是内存多占了一点
" }3 l4 \5 Q* c3 f0 f/ J, c7 n这段相当于对象指针设置，对吧

如果“在EXCEL修改尺寸”，还有一种办法，用DDE，就是在excel中修改参数后，WS中自动就改过来了
DDE现在似乎只是用在excel中，其他地方不常见了

+ i1 C8 _. x+ h* m, x7 S

ryouss

zmztx 发表于 2019-7-8 14:48
SW2016，还没有装好
7 Q1 [2 j5 \% [+ x) l刚开始，看到最上面的代码

  _9 e( g% Y/ Y; L難得zmztx大大能深入探討很不錯.
8 q/ ~9 E) A/ N5 k
) k" b4 |. c! W& X" H/ c1. 是可以簡化去掉 Function SetSwPart()

! S% Q* h+ d$ F

1. '~~~~~~~~~~~~~~~~~~ 2019/07/06 V19070601 ~~~
   
2. ' 操作:
   
3. '   1. 開 EXCEL文件.
   
4. '   2. 開 SW零件.
   
5. '   3. 執行 ReadSwDimensionInSldPrt().
   
6. '   4. 在EXCEL修改尺寸.
   ( v" i" g1 C2 _: J  [
7. '
   , B% {7 g! e. y
8. ' 功能:
   
9. '   1. 讀取SW零件的全部尺寸,寫到 Excel.
   
10. '   2. 在Excel變動尺寸后,修改SW的零件尺寸.
    $ f0 H3 K3 r5 M) h$ Z
11. '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    ! j% S( S4 z$ L) k) u$ G
12. 
    , p# q5 p% g! t! n
13.   Dim SwApp As Object
    
14.   Dim boolStatus As Boolean
    0 z- |6 F+ S2 {& c8 L% _
15.   Dim swFeat As Object ', swSubFeat As Object
    : ?$ t6 m4 }* y9 A) b
16.   Dim swDispDim As Object, SwDim As Object
    0 m6 J' P9 Y; Z$ o
17.   Dim Str
    4 K4 [) D' ?4 z% C
18.   Dim oDic
    
19.   Dim oArr1, oArr2
    
20.   
    
21. Sub ReadSwDimensionInSldPrt()
    - m5 ?( \% j: \$ R1 ]* n$ O2 x( T
22.   '讀取SW的全部尺寸
    
23.     Set SwApp = Application.SldWorks
    - W2 O2 l# H3 p- C9 J
24.     Set Part = SwApp.ActiveDoc
    ' e$ f: S" h- ?, Z7 z* w
25.     Set oDic = CreateObject("Scripting.Dictionary")
      k+ P) s8 o/ }8 x7 ?) g# P
26. '*** Get active sheet in Excel
    3 D2 d& c; M1 U& Y- _
27.     Set xl = GetObject(, "Excel.Application")
    
28. With xl.ActiveSheet
    
29.     Set swFeat = Part.FirstFeature
    + j; X  c+ ?6 w) l4 g2 }
30.     kk = 1
    
31.     Do While Not swFeat Is Nothing
    ( w, O  z+ l$ @" ~# w( z5 M2 E
32.         Debug.Print "  " + swFeat.Name
    * Y7 f  J4 ]2 Z, f# U; E
33.         'Set swSubFeat = swFeat.GetFirstSubFeature
    * A& I' y* f6 _
34.         Set swDispDim = swFeat.GetFirstDisplayDimension
    
35.         Do While Not swDispDim Is Nothing
    
36.             'Set swAnn = swDispDim.GetAnnotation
    
37.             Set SwDim = swDispDim.GetDimension
    ( L3 `  E7 E) N& i7 O& [
38.             Str = SwDim.FullName '特徵樹名稱
    % x  T0 D& y3 L8 J# T
39.             oArr = Split(Str, "@")
    / w! X6 c- N  G7 b/ J
40.             Str = oArr(0) & "@" & oArr(1)
    ) J' V8 K1 Q2 }& I' {' n9 g5 F/ }
41.             oDic(Str) = SwDim.GetSystemValue2("")
    
42.             Set swDispDim = swFeat.GetNextDisplayDimension(swDispDim)
    
43.             Debug.Print Str, oDic(Str) ', 符號相當於按Tab鍵
    ( h& H! l8 k$ O9 T, u
44.             kk = kk + 1
    
45.         Loop
    , H% N$ }# W1 R3 J4 I- v, `- y
46.         Set swFeat = swFeat.GetNextFeature
    
47.     Loop
    
48.     oArr1 = oDic.keys: oArr2 = oDic.Items
    
49.     .cells(1, 1) = "Serial number": .cells(1, 2) = "Array staging": .cells(1, 3) = "Dimension name"
    4 k- [3 w( ?+ V) Z6 E
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
    
53.         .cells(kk, 2) = "=" & """Arr(""" & " & " & .cells(kk, 1) & " & " & """)="""
    
54.         .cells(kk, 3) = "'" & Chr(34) & oArr1(kk - 2) & Chr(34)
    2 K5 J  U  X3 y) E& y( t$ o
55.         .cells(kk, 4) = Split(oArr1(kk - 2), "@")(1) '(1)僅讀取特徵名
    
56.         .cells(kk, 5) = oArr2(kk - 2)
    
57.     Next kk
    
58. nn = .Range("C65536").End(3).Row 'End(3)==>End(xlUp)
    
59. Stop '暫停修改Excel之尺寸後,再按RUN執行鍵
    3 c9 e0 j' k9 S( |0 o% P
60. Set Part = SwApp.ActiveDoc
    + E5 i$ o% Y& p- E
61. '依據Excel變動值修改到sw零件
    
62. For mm = 2 To nn
    ( M! [# |' C; l$ t
63.     Size_name = Mid(.cells(mm, 3), 2, Len(.cells(mm, 3)) - 2)
    
64.     Part.Parameter(Size_name).SystemValue = .cells(mm, 5)
    ! F: |" V, h* T% ~" U
65. Next mm
    / Q' l3 r! h8 w8 ]/ V' e
66. End With
    
67. boolStatus = Part.EditRebuild3()
    ! U& u1 k4 Q7 [7 Z7 {
68. MsgBox "Part size modification ends" '零件尺寸修改結束
    
69. End Sub
    4 d- M. W/ f5 W* a6 I5 k

复制代码

' R8 v3 C- ~( |0 b" A+ u4 b. Z
; t0 o+ A8 e7 E: V6 _% i+ a" x
2. 另也可以直接寫在 EXCEL
! Z. Q3 I5 z$ [$ {- L0 f

zmztx

3 r9 O9 W1 j0 l: ]! D1 _% L6 A
我没有去掉function的意思，反而觉得用一些function，sub，更好。容易读，容易改。不过自己用，自己觉得好就好

“58.nn = .Range("C65536").End(3).Row
你这是Excel2003？
从excel，SW的数据读进来，处理以后再写回去
以前在solidedge中，用过这种方式，发现一个问题，solidedge的数据有一个半角字符，写到excel中看不出来。费了不少时间
4 I1 }6 q* [6 ?0 w: J这事在sw中不知道有没有