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

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

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

ryouss 发表于 2019-7-6 11:50
( H# I, t0 J) s9 H; ]7 S# V什麼版本測試的,顯示什麼錯誤提示?

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& n$ R6 K: Y: @; V) L) V

把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
: z9 A) J; g6 K; T* tSW2016，还没有装好
/ V d* @ o% J+ S6 `7 U刚开始，看到最上面的代码

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

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

'~~~~~~~~~~~~~~~~~~ 2019/07/06 V19070601 ~~~
7 l( A; E: P& u9 ^7 }) f
' 操作:
# M" ?& X4 V- Z+ U4 K5 P
' 1. 開 EXCEL文件.
- n/ H f" U/ T
' 2. 開 SW零件.- {& e, Y/ H4 }5 l M# k5 s% w N
' 3. 執行 ReadSwDimensionInSldPrt().# ~) `* @6 K) _; o
' 4. 在EXCEL修改尺寸.
( C# S7 C) o; P- P+ ]
'/ s# ~$ \0 h! v3 s4 x! C4 {
' 功能:
. H- Y& Y% Y3 q5 y3 O
' 1. 讀取SW零件的全部尺寸,寫到 Excel.
v5 ~) S1 b. R0 O5 r6 t
' 2. 在Excel變動尺寸后,修改SW的零件尺寸.
) @) m9 v1 A: ~% W5 {8 u1 x {: j
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
) Z& \$ A0 E; g" h
1 ~4 C/ z, D' l8 V0 F
Dim SwApp As Object6 S- o4 u- S, C/ s2 X q8 B" z
Dim boolStatus As Boolean
* T; q2 K, l- S
Dim swFeat As Object ', swSubFeat As Object5 o! V2 {- M! Y! ^. |1 ?& {% d- q
Dim swDispDim As Object, SwDim As Object; u/ p5 n ^' o7 s
Dim Str; @$ g+ V& y& a; {. G9 @
Dim oDic
7 d1 A6 K) d8 F( \2 [/ Q
Dim oArr1, oArr28 o/ t+ i/ U! i9 U6 \
/ u9 C8 z) G) q' v* P
Sub ReadSwDimensionInSldPrt()
+ R" p+ N8 b" G( f5 S) a% @
'讀取SW的全部尺寸
" ~$ k; i/ Q0 j! @" Q. _6 v- R
Set SwApp = Application.SldWorks
) A5 U8 s1 v1 B" b0 t
Set Part = SwApp.ActiveDoc
( R# i. q) a, Q2 _$ B9 C1 u
Set oDic = CreateObject("Scripting.Dictionary")
0 J6 n. V/ N9 ?8 K
'*** Get active sheet in Excel- D7 F4 A# D4 ^
Set xl = GetObject(, "Excel.Application")/ T7 ~# \. D1 n- ^3 P* L# Y/ X
With xl.ActiveSheet
# Q8 ^, t& L: t$ J# f1 N. m
Set swFeat = Part.FirstFeature
" [- ^, S# ^6 s) m/ N* @' @
kk = 1# Z. y/ n$ C: D) p5 n# F4 E
Do While Not swFeat Is Nothing
# l0 y: ]9 O& V" m: j
Debug.Print " " + swFeat.Name
& @( \4 c0 y6 [% g1 p
'Set swSubFeat = swFeat.GetFirstSubFeature3 c! S6 ^' _3 k, X
Set swDispDim = swFeat.GetFirstDisplayDimension
% @+ d$ j. |/ S6 g/ F1 y
Do While Not swDispDim Is Nothing
; O* s/ a3 T1 j( V* n' A
'Set swAnn = swDispDim.GetAnnotation
' ^- q* Y R. L+ s. e3 j; m! X& f
Set SwDim = swDispDim.GetDimension
. E) x3 e7 o: P
Str = SwDim.FullName '特徵樹名稱
- ?) M# C) m5 u
oArr = Split(Str, "@")8 h4 C; k* ]# U. p) k! z9 c9 H9 B
Str = oArr(0) & "@" & oArr(1) |# @; Q5 h3 ], B$ N; d8 `
oDic(Str) = SwDim.GetSystemValue2("")
; C8 n r' x5 `$ g
Set swDispDim = swFeat.GetNextDisplayDimension(swDispDim)1 s) a8 y; j& f5 Y1 o
Debug.Print Str, oDic(Str) ', 符號相當於按Tab鍵
. r9 D5 y5 w- |4 t7 _0 D& a$ d. u8 j- P
kk = kk + 1# ]" D' ~; A: i) m" s U4 f
Loop% L$ G2 a' ]( `1 E% h. T
Set swFeat = swFeat.GetNextFeature
) H! q( I9 f1 Z% w( z' w; D
Loop
) S4 O% B2 ^' [+ e' p {& P
oArr1 = oDic.keys: oArr2 = oDic.Items
0 X. R4 G. X T3 e
.cells(1, 1) = "Serial number": .cells(1, 2) = "Array staging": .cells(1, 3) = "Dimension name"
# T7 }1 f" }% c+ \( |% p; Z
.cells(1, 4) = "Feature name": .cells(1, 5) = "Dimension value"
. w" g ^" E4 }9 L' P
For kk = 2 To UBound(oArr1) + 2# a, h+ s% B1 @$ F
.cells(kk, 1) = kk - 2
0 N0 d5 `; @* e9 Q) Q( ?
.cells(kk, 2) = "=" & """Arr(""" & " & " & .cells(kk, 1) & " & " & """)="""
1 O0 t# y/ {/ q; U
.cells(kk, 3) = "'" & Chr(34) & oArr1(kk - 2) & Chr(34)
. d$ x9 |" n* E' g
.cells(kk, 4) = Split(oArr1(kk - 2), "@")(1) '(1)僅讀取特徵名
- K& h, {: n+ x8 J
.cells(kk, 5) = oArr2(kk - 2)7 u. g z% I9 m$ @0 c
Next kk
7 p0 }5 F5 Y- s! ^5 k# o# V/ ^
nn = .Range("C65536").End(3).Row 'End(3)==>End(xlUp)% k) ^2 ^3 X* o
Stop '暫停修改Excel之尺寸後,再按RUN執行鍵0 S7 |8 c2 ~4 d8 ~, [( R
Set Part = SwApp.ActiveDoc, ~- r& G, D( h9 t9 z
'依據Excel變動值修改到sw零件. x8 T. f. A6 `3 ?
For mm = 2 To nn
0 V' B8 f- Q4 s' U1 X! i/ _
Size_name = Mid(.cells(mm, 3), 2, Len(.cells(mm, 3)) - 2)7 h; c: z4 i7 T" x# V
Part.Parameter(Size_name).SystemValue = .cells(mm, 5)
: z2 o U+ `! Q" Y$ X
Next mm4 x2 G. w5 x/ m+ _+ Q6 h" M) Z
End With
' w+ ` u m4 P; x
boolStatus = Part.EditRebuild3()5 o8 V; m X' G4 {, v
MsgBox "Part size modification ends" '零件尺寸修改結束% r6 r) @2 w$ d' W" u
End Sub8 o! h7 g* J: B# \2 C+ u- t

复制代码

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零件尺寸-宏的練習

本帖子中包含更多资源

点评