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

zmztx · 发表于 2019-7-8 14:48:03

本帖最后由 zmztx 于 2019-7-8 14:52 编辑

ryouss 发表于 2019-7-6 11:507 }2 z8 y! Z1 D) q6 \
什麼版本測試的,顯示什麼錯誤提示?

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
}, S7 _* d: U" D: A3 H- R

把function看成了sub，这样就不行了。
如果是Function SetSwPart() as object就更清楚了，当然这么些也没错，就是内存多占了一点
这段相当于对象指针设置，对吧

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

ryouss · 发表于 2019-7-9 09:50:14

zmztx 发表于 2019-7-8 14:48% G* k6 \; M& _2 D2 z. N. C, D
SW2016，还没有装好
2 s0 |( N; K4 ~% N- W1 k, J刚开始，看到最上面的代码

難得zmztx大大能深入探討很不錯.

1. 是可以簡化去掉 Function SetSwPart()

'~~~~~~~~~~~~~~~~~~ 2019/07/06 V19070601 ~~~# M0 F+ V* A! ~# o5 _: I4 b
' 操作:6 y! I1 R+ ?5 d; p2 b$ y8 G, c5 O
' 1. 開 EXCEL文件.
8 {' ^. H* P3 e9 d2 D% t
' 2. 開 SW零件.
3 B; v, e; M( v$ q
' 3. 執行 ReadSwDimensionInSldPrt().
: | z6 P2 h& j' H0 L
' 4. 在EXCEL修改尺寸.
/ ^2 n3 S# u( c) ~8 _
'
) F1 J t" m( o. }- E
' 功能:, k& r$ `( y c3 J7 v/ u) W6 W( ?3 T
' 1. 讀取SW零件的全部尺寸,寫到 Excel.& |' M) m% f0 p0 ~3 j& ]0 o' V3 _
' 2. 在Excel變動尺寸后,修改SW的零件尺寸.# y( o( f- N `
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~* [6 O @! U7 ^8 s
* f( e/ E+ D- E
Dim SwApp As Object
f3 P* u& y7 a1 F: k0 A
Dim boolStatus As Boolean o- V }8 g1 G+ @7 {: @
Dim swFeat As Object ', swSubFeat As Object
" G: a8 j3 w! p# p7 N. Y2 L
Dim swDispDim As Object, SwDim As Object
7 t5 [6 p8 q* v9 x5 o; E: q
Dim Str" p( `- W# c: s. k
Dim oDic7 t. K1 e/ K. H0 x7 p
Dim oArr1, oArr2
$ A$ O: ?5 D- M" F
6 e7 d) u3 e2 {2 y2 ~& p5 q
Sub ReadSwDimensionInSldPrt()
0 W& _% ?7 Y$ ]+ z/ `* M3 Z
'讀取SW的全部尺寸
; i7 w4 G2 R" V ? ?5 K8 i0 \4 ~
Set SwApp = Application.SldWorks' d, g& N- O- w# R- n% I! a1 P; e/ P
Set Part = SwApp.ActiveDoc/ x, y7 D' I' l) ~0 b
Set oDic = CreateObject("Scripting.Dictionary"), n& k, @* j2 T1 m' h, p4 e
'*** Get active sheet in Excel
_3 [! Z& L( J7 d G' X0 x
Set xl = GetObject(, "Excel.Application")
% |0 a7 m; x c" o% y! k
With xl.ActiveSheet" T% |& Y" ]6 O# H Z) J
Set swFeat = Part.FirstFeature
" \" e3 Z5 E7 f2 G' \# A9 T. |
kk = 1 d( y9 \4 a; E+ c
Do While Not swFeat Is Nothing
0 O$ z6 E2 @9 d" ], b
Debug.Print " " + swFeat.Name6 K( H( }2 n5 l; U( T) z3 i
'Set swSubFeat = swFeat.GetFirstSubFeature* q/ n- R p8 K7 E
Set swDispDim = swFeat.GetFirstDisplayDimension- n1 x1 I& m) u3 U% y( l2 G( J
Do While Not swDispDim Is Nothing
. g) a7 J: m7 k9 \* S$ ]% G! V) o( a
'Set swAnn = swDispDim.GetAnnotation
6 G D( |: p# U" S
Set SwDim = swDispDim.GetDimension
0 w2 X" G R8 f |1 g: Q
Str = SwDim.FullName '特徵樹名稱4 I7 E8 _! S4 L# Y0 l4 \
oArr = Split(Str, "@")
9 ]- Q2 ]' P2 v' v3 S+ i
Str = oArr(0) & "@" & oArr(1), Y; @0 T8 c! j# X& ]$ B5 Z" k" j' o
oDic(Str) = SwDim.GetSystemValue2("")' F* g, V0 k; c& k$ y" |" O
Set swDispDim = swFeat.GetNextDisplayDimension(swDispDim)
3 q; e' }/ r6 A! l! q& u1 g1 @
Debug.Print Str, oDic(Str) ', 符號相當於按Tab鍵
* t; h+ ]$ M$ p6 H, g
kk = kk + 1" }9 |1 o3 G* P* `" D% I+ O
Loop1 i) r$ F) O M: @* G+ b
Set swFeat = swFeat.GetNextFeature
6 j0 `( g" ?6 L! n
Loop
) H% j$ r' n2 F7 C, M4 L1 y0 D
oArr1 = oDic.keys: oArr2 = oDic.Items
: \5 h1 r9 W" F( b( {
.cells(1, 1) = "Serial number": .cells(1, 2) = "Array staging": .cells(1, 3) = "Dimension name"5 d3 U8 A# F6 M# L
.cells(1, 4) = "Feature name": .cells(1, 5) = "Dimension value"' D/ e/ A/ J4 N) X1 Q
For kk = 2 To UBound(oArr1) + 2, J' s3 g) @$ d# V8 U- ]4 n3 i
.cells(kk, 1) = kk - 2! J. P. |4 J# E
.cells(kk, 2) = "=" & """Arr(""" & " & " & .cells(kk, 1) & " & " & """)="""! c: s7 m2 s, Q5 l
.cells(kk, 3) = "'" & Chr(34) & oArr1(kk - 2) & Chr(34)1 L' o' p8 L0 N+ Q6 G% Z7 r
.cells(kk, 4) = Split(oArr1(kk - 2), "@")(1) '(1)僅讀取特徵名9 C; h: E8 E" ?8 I8 q: v! ?. P4 _
.cells(kk, 5) = oArr2(kk - 2). Y' [8 F0 A r# r" g0 @
Next kk. s1 |5 C/ m" t0 J7 O! o
nn = .Range("C65536").End(3).Row 'End(3)==>End(xlUp)$ L1 J7 s: c0 A+ X1 c4 Q7 r
Stop '暫停修改Excel之尺寸後,再按RUN執行鍵9 J$ U' l8 Z5 `3 s; u& F7 A
Set Part = SwApp.ActiveDoc
( l. k, K# t3 \1 T& `! X
'依據Excel變動值修改到sw零件
" d6 `& z r8 s9 N
For mm = 2 To nn# N$ Y, V% [' g1 k* G @/ A
Size_name = Mid(.cells(mm, 3), 2, Len(.cells(mm, 3)) - 2)& h7 }/ |8 k6 P& q, t& x+ \ e
Part.Parameter(Size_name).SystemValue = .cells(mm, 5)
' r3 y4 x, s) T r4 l
Next mm
Y: i; W' {6 Y; J g( T
End With
/ w5 ^2 p5 x2 ?/ f7 U
boolStatus = Part.EditRebuild3()" Z* L7 p, B4 s& O! T
MsgBox "Part size modification ends" '零件尺寸修改結束
' o# e1 y5 J; j" `# R( W
End Sub
4 S' a- A- p' k' b0 u& x8 V6 W5 W# H

复制代码

2. 另也可以直接寫在 EXCEL

zmztx · 发表于 2019-7-9 15:08:53

本帖最后由 zmztx 于 2019-7-9 15:17 编辑

我没有去掉function的意思，反而觉得用一些function，sub，更好。容易读，容易改。不过自己用，自己觉得好就好

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

		自动登录	找回密码
密码			注册会员

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

本帖子中包含更多资源

点评