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

zmztx

ryouss 发表于 2019-7-6 11:50
什麼版本測試的,顯示什麼錯誤提示?

SW2016，还没有装好
. W# t; z# {7 U$ t* m) V5 F, X刚开始，看到最上面的代码

• 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，这样就不行了。
7 H8 D6 t5 g$ N/ V# v2 ~如果是Function SetSwPart() as object就更清楚了，当然这么些也没错，就是内存多占了一点
这段相当于对象指针设置，对吧

如果“在EXCEL修改尺寸”，还有一种办法，用DDE，就是在excel中修改参数后，WS中自动就改过来了
# b* V$ t$ G; Z8 YDDE现在似乎只是用在excel中，其他地方不常见了
& v: c0 z* [" g" C2 y8 U

ryouss

zmztx 发表于 2019-7-8 14:48
8 K+ N5 Y2 U! v+ w  RSW2016，还没有装好
4 e& C( l& G4 P$ f* L4 n+ M) J刚开始，看到最上面的代码

( b8 C6 p& N; Y$ }難得zmztx大大能深入探討很不錯.
6 S& ^' y+ n) J0 ^; }5 ~  Z) x
1. 是可以簡化去掉 Function SetSwPart()
9 W" o$ G$ D! N6 X6 W

1. '~~~~~~~~~~~~~~~~~~ 2019/07/06 V19070601 ~~~
   $ v3 S$ P- u7 j1 S, z) O1 a
2. ' 操作:
   
3. '   1. 開 EXCEL文件.
   0 T: u; M) y) Y3 Z1 h0 W+ v
4. '   2. 開 SW零件.
   $ g. U( p( q; `
5. '   3. 執行 ReadSwDimensionInSldPrt().
   ; x' ?, w/ X5 U7 D$ d
6. '   4. 在EXCEL修改尺寸.
   2 \, k3 q; i+ ~# [$ q6 z4 v
7. '
   
8. ' 功能:
   
9. '   1. 讀取SW零件的全部尺寸,寫到 Excel.
   
10. '   2. 在Excel變動尺寸后,修改SW的零件尺寸.
    . L- U/ D5 G) ]$ L$ I0 }
11. '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    % A8 `8 G7 R5 s0 n" S5 b1 O/ e
12. 
    
13.   Dim SwApp As Object
    8 X! H# {6 u1 G, M9 z
14.   Dim boolStatus As Boolean
    
15.   Dim swFeat As Object ', swSubFeat As Object
    
16.   Dim swDispDim As Object, SwDim As Object
    
17.   Dim Str
    , K7 I6 P# }* x9 n7 N/ ]
18.   Dim oDic
    
19.   Dim oArr1, oArr2
    % ?5 L" d* N, ~9 R% y0 i$ Q
20.   
    
21. Sub ReadSwDimensionInSldPrt()
    . d( u2 _: B8 c* ~! L0 j, r! G! ~0 N: O
22.   '讀取SW的全部尺寸
    
23.     Set SwApp = Application.SldWorks
    : x3 N: p* i# H% C
24.     Set Part = SwApp.ActiveDoc
    
25.     Set oDic = CreateObject("Scripting.Dictionary")
    
26. '*** Get active sheet in Excel
    ) H' z5 v8 Z* v) ?6 E+ r# G$ d& ?9 g; A/ [
27.     Set xl = GetObject(, "Excel.Application")
    
28. With xl.ActiveSheet
    
29.     Set swFeat = Part.FirstFeature
    
30.     kk = 1
    4 a3 _8 X) K+ Z8 n0 R4 B
31.     Do While Not swFeat Is Nothing
    
32.         Debug.Print "  " + swFeat.Name
    
33.         'Set swSubFeat = swFeat.GetFirstSubFeature
    0 m7 E6 \3 ^5 \
34.         Set swDispDim = swFeat.GetFirstDisplayDimension
      `. u* r0 I- N$ N, u
35.         Do While Not swDispDim Is Nothing
    0 Z- Z, V  a3 ?2 Y
36.             'Set swAnn = swDispDim.GetAnnotation
    9 }  I& |. ?/ w( {/ o$ G$ v
37.             Set SwDim = swDispDim.GetDimension
    
38.             Str = SwDim.FullName '特徵樹名稱
    - h0 N/ i: Y6 l$ ]6 y
39.             oArr = Split(Str, "@")
    ( S# y1 r5 h9 U% e4 S  }! s" z
40.             Str = oArr(0) & "@" & oArr(1)
    
41.             oDic(Str) = SwDim.GetSystemValue2("")
    8 K* L- K7 E6 c* \- _" ]+ P
42.             Set swDispDim = swFeat.GetNextDisplayDimension(swDispDim)
    
43.             Debug.Print Str, oDic(Str) ', 符號相當於按Tab鍵
    
44.             kk = kk + 1
    
45.         Loop
    3 h# l7 \, l9 s
46.         Set swFeat = swFeat.GetNextFeature
    
47.     Loop
    : P2 g9 x. R( Q
48.     oArr1 = oDic.keys: oArr2 = oDic.Items
    
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"
    , C7 V1 S" `  ?+ }, d1 g# |
51.     For kk = 2 To UBound(oArr1) + 2
    
52.         .cells(kk, 1) = kk - 2
    * Y6 V9 r7 L, g5 z' U  v; d
53.         .cells(kk, 2) = "=" & """Arr(""" & " & " & .cells(kk, 1) & " & " & """)="""
    ) _  i" D6 {# N" P, Q/ ^0 c
54.         .cells(kk, 3) = "'" & Chr(34) & oArr1(kk - 2) & Chr(34)
    
55.         .cells(kk, 4) = Split(oArr1(kk - 2), "@")(1) '(1)僅讀取特徵名
    9 T) T; @0 r9 z) J( v1 u
56.         .cells(kk, 5) = oArr2(kk - 2)
    
57.     Next kk
    " p' n. f1 Q8 Y# T* E
58. nn = .Range("C65536").End(3).Row 'End(3)==>End(xlUp)
    
59. Stop '暫停修改Excel之尺寸後,再按RUN執行鍵
    % g4 x+ h% f6 J. r/ b; d+ l
60. Set Part = SwApp.ActiveDoc
    
61. '依據Excel變動值修改到sw零件
    
62. For mm = 2 To nn
    1 Q% c7 A4 S4 F- x$ e
63.     Size_name = Mid(.cells(mm, 3), 2, Len(.cells(mm, 3)) - 2)
    8 Q3 B0 _6 H6 P  y3 j
64.     Part.Parameter(Size_name).SystemValue = .cells(mm, 5)
    
65. Next mm
    
66. End With
    
67. boolStatus = Part.EditRebuild3()
    9 [  g) r! B- D6 [/ }, e8 U$ v7 ~
68. MsgBox "Part size modification ends" '零件尺寸修改結束
    - F/ o. p6 U8 G; Z$ n
69. End Sub
    1 }! d5 U! D1 u- \9 I

复制代码

4 g  {- Q7 Y5 J. {! x& }2. 另也可以直接寫在 EXCEL

8 l* _' b: L5 u  N9 J0 E3 k4 y

zmztx

5 N( K9 O2 \( I( g( D我没有去掉function的意思，反而觉得用一些function，sub，更好。容易读，容易改。不过自己用，自己觉得好就好
) u0 f$ ?8 H& v: G
2 q. M6 n+ f( B) r8 r# V) f4 S“58.nn = .Range("C65536").End(3).Row
你这是Excel2003？
从excel，SW的数据读进来，处理以后再写回去
以前在solidedge中，用过这种方式，发现一个问题，solidedge的数据有一个半角字符，写到excel中看不出来。费了不少时间
这事在sw中不知道有没有