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

zmztx

4 c: J3 _$ E' D# j" o

ryouss 发表于 2019-7-6 11:50
& ]; B1 Y8 n8 G/ H' j什麼版本測試的,顯示什麼錯誤提示?

SW2016，还没有装好
刚开始，看到最上面的代码
( g( Q+ q4 E- C% O. g

• 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，这样就不行了。
3 r6 Y  _, Y% h1 ^# P6 Z. y如果是Function SetSwPart() as object就更清楚了，当然这么些也没错，就是内存多占了一点
+ a7 B! V  n1 q; {4 A这段相当于对象指针设置，对吧

, `  L" ~! ?% C' n$ k9 N4 Y如果“在EXCEL修改尺寸”，还有一种办法，用DDE，就是在excel中修改参数后，WS中自动就改过来了
DDE现在似乎只是用在excel中，其他地方不常见了

% F% N. H% b: |4 H. f, w

ryouss

zmztx 发表于 2019-7-8 14:48
SW2016，还没有装好
8 u9 E2 _% H4 P1 S刚开始，看到最上面的代码

' N4 \; W, A0 d% e難得zmztx大大能深入探討很不錯.
& @. B- d4 w' [
$ k! A# I: h8 O9 I* A1. 是可以簡化去掉 Function SetSwPart()

# @+ {( \7 r* x  D. Q# c# k' v2 x

1. '~~~~~~~~~~~~~~~~~~ 2019/07/06 V19070601 ~~~
   
2. ' 操作:
   & ?7 n) T. s* O9 r1 l
3. '   1. 開 EXCEL文件.
   
4. '   2. 開 SW零件.
   # d: U9 r4 V( y! a
5. '   3. 執行 ReadSwDimensionInSldPrt().
   7 o+ R* w" F: L
6. '   4. 在EXCEL修改尺寸.
   
7. '
   
8. ' 功能:
   
9. '   1. 讀取SW零件的全部尺寸,寫到 Excel.
   
10. '   2. 在Excel變動尺寸后,修改SW的零件尺寸.
    
11. '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    ' i+ x) u2 G& [8 M% ?: ~* g
12. 
    8 B3 r, t, \/ |! z' J
13.   Dim SwApp As Object
    
14.   Dim boolStatus As Boolean
      Y! O" S/ J) H0 F! ^
15.   Dim swFeat As Object ', swSubFeat As Object
    ; }* d& Z6 o! m! J+ C& g' W
16.   Dim swDispDim As Object, SwDim As Object
    # j8 {3 a3 M7 N/ z
17.   Dim Str
    
18.   Dim oDic
    
19.   Dim oArr1, oArr2
    3 a& A/ ~2 S, |: L9 R3 ]" Z
20.   
    
21. Sub ReadSwDimensionInSldPrt()
    
22.   '讀取SW的全部尺寸
    # ?5 v9 m% `8 j2 A2 a
23.     Set SwApp = Application.SldWorks
    
24.     Set Part = SwApp.ActiveDoc
    
25.     Set oDic = CreateObject("Scripting.Dictionary")
    
26. '*** Get active sheet in Excel
    " T$ M) o1 c; {
27.     Set xl = GetObject(, "Excel.Application")
    
28. With xl.ActiveSheet
    # {' o! _, z  u( b# l
29.     Set swFeat = Part.FirstFeature
    
30.     kk = 1
    6 E/ Q) u$ X. F- ]
31.     Do While Not swFeat Is Nothing
    
32.         Debug.Print "  " + swFeat.Name
    
33.         'Set swSubFeat = swFeat.GetFirstSubFeature
    ' A- u0 Q+ E1 Q5 b. @5 k1 Y
34.         Set swDispDim = swFeat.GetFirstDisplayDimension
    
35.         Do While Not swDispDim Is Nothing
    5 y- z$ E" p& y6 ?. E7 n4 F9 T
36.             'Set swAnn = swDispDim.GetAnnotation
    ( j- g$ y* Z6 t: ]) m; I
37.             Set SwDim = swDispDim.GetDimension
    
38.             Str = SwDim.FullName '特徵樹名稱
    % _# i$ F$ ^( C- L
39.             oArr = Split(Str, "@")
    - d8 L5 y# Q* n1 s+ O# P! \
40.             Str = oArr(0) & "@" & oArr(1)
    
41.             oDic(Str) = SwDim.GetSystemValue2("")
    
42.             Set swDispDim = swFeat.GetNextDisplayDimension(swDispDim)
    : w' s  p& e/ w+ @6 `9 _
43.             Debug.Print Str, oDic(Str) ', 符號相當於按Tab鍵
    + H% I5 `; _7 M1 X  V
44.             kk = kk + 1
    
45.         Loop
    ' n& {$ l( H, X5 _4 q0 Q
46.         Set swFeat = swFeat.GetNextFeature
      m- z2 v6 h# F1 h! ^" e) r
47.     Loop
    
48.     oArr1 = oDic.keys: oArr2 = oDic.Items
    ( P& X) q0 o4 t& h* R
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"
    
51.     For kk = 2 To UBound(oArr1) + 2
    0 J  L$ P; N, w- ~
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)
    
55.         .cells(kk, 4) = Split(oArr1(kk - 2), "@")(1) '(1)僅讀取特徵名
    
56.         .cells(kk, 5) = oArr2(kk - 2)
    - l0 s! r$ ]; i* `! c. J
57.     Next kk
    
58. nn = .Range("C65536").End(3).Row 'End(3)==>End(xlUp)
    $ L  d; u% y. F4 T) P/ d/ L7 d
59. Stop '暫停修改Excel之尺寸後,再按RUN執行鍵
    / T0 s  b) [! Q
60. Set Part = SwApp.ActiveDoc
    
61. '依據Excel變動值修改到sw零件
    
62. For mm = 2 To nn
    * u2 V2 b+ H7 t. ^; ]8 m
63.     Size_name = Mid(.cells(mm, 3), 2, Len(.cells(mm, 3)) - 2)
    : _' z8 d" Y8 K7 S! H$ J( f" D
64.     Part.Parameter(Size_name).SystemValue = .cells(mm, 5)
    
65. Next mm
    - a: P: x+ ^6 M/ i. d/ j( _% G
66. End With
    ; G" G# `9 S; Q, Q. Z  q
67. boolStatus = Part.EditRebuild3()
    # A! C4 K* X2 e# v; T/ \( G1 M
68. MsgBox "Part size modification ends" '零件尺寸修改結束
    $ J& t$ Y7 W/ _9 O
69. End Sub
    % M2 i5 t6 ^9 [9 p6 M; e8 x' v

复制代码

; ~- K- r; u8 A
7 G: I8 \# A7 ]- c" _) ]2. 另也可以直接寫在 EXCEL

zmztx

# o7 k7 B% @  F9 v1 o% t我没有去掉function的意思，反而觉得用一些function，sub，更好。容易读，容易改。不过自己用，自己觉得好就好

: J& ~: ?4 G8 b1 x$ g“58.nn = .Range("C65536").End(3).Row
- O3 @, ^6 Y: |; b5 U0 m2 p! C你这是Excel2003？
从excel，SW的数据读进来，处理以后再写回去
以前在solidedge中，用过这种方式，发现一个问题，solidedge的数据有一个半角字符，写到excel中看不出来。费了不少时间
这事在sw中不知道有没有