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

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

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

ryouss 发表于 2019-7-6 11:50
$ P) Q* \+ V# b7 v! u- i什麼版本測試的,顯示什麼錯誤提示?

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
. V5 P. V4 c1 B8 g$ G' `" k

把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 . i# x& j$ c' x0 D9 V
SW2016，还没有装好 e1 @; n* j0 u. R/ _
刚开始，看到最上面的代码

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

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

'~~~~~~~~~~~~~~~~~~ 2019/07/06 V19070601 ~~~
3 Y2 e3 @6 X0 I. a9 K5 Q1 R- b4 w
' 操作:/ e+ {- J' A% I1 @8 X3 E
' 1. 開 EXCEL文件.
, e8 n6 }- ?3 t J
' 2. 開 SW零件.l' D; d! K: w: X
' 3. 執行 ReadSwDimensionInSldPrt().
% d5 I3 Z2 d0 t
' 4. 在EXCEL修改尺寸.
) D, }) J$ Z% d% r ?
'4 b* x+ T8 p/ r
' 功能:4 D6 p! [1 ]0 R0 w5 q1 E$ n
' 1. 讀取SW零件的全部尺寸,寫到 Excel.
q' ^5 `3 b% f8 Z$ U& x( u
' 2. 在Excel變動尺寸后,修改SW的零件尺寸.p$ N( Z0 |3 s( @ ?
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~6 N6 o: Z8 W# S" o! W
. V. E' m: H1 s# y3 Y6 K e
Dim SwApp As Object
% C3 E3 ]! _* ^8 t$ g
Dim boolStatus As Boolean0 d% D6 c3 D4 M& J5 c n, C$ F
Dim swFeat As Object ', swSubFeat As Object
0 p" t5 u' D0 D$ B2 A
Dim swDispDim As Object, SwDim As Object7 D, M3 @& ?0 Q& r" u6 I- F( }
Dim Str! ?$ h% f. P1 s1 V
Dim oDic, o7 ?1 z1 ^3 ~& b- Y) `
Dim oArr1, oArr2
9 Q& W. ^& P* C' ~! F8 Z
7 R0 F: Q+ L" _6 H2 q! @2 t
Sub ReadSwDimensionInSldPrt(). x$ F6 w: g( l- L. w; a
'讀取SW的全部尺寸
- b' O4 ~2 u: t8 @5 U7 ?7 }) }2 t
Set SwApp = Application.SldWorks7 s u5 e! [; l1 F
Set Part = SwApp.ActiveDoc) |* A6 @4 |5 p8 F$ K
Set oDic = CreateObject("Scripting.Dictionary")6 C6 p1 u* I3 p
'*** Get active sheet in Excel
1 Z3 `( \' R. s- S$ j
Set xl = GetObject(, "Excel.Application"): \8 G3 e, B& y: F u: b
With xl.ActiveSheet
3 j, `+ {- X+ |
Set swFeat = Part.FirstFeature3 B. A3 }( b5 o5 O& }$ Z
kk = 1
p. b! r/ s" N( B) d$ }1 k
Do While Not swFeat Is Nothing
! a: E" U- o) K0 r& N G2 z
Debug.Print " " + swFeat.Name5 B4 K0 a! L k. G3 S( s/ v! R
'Set swSubFeat = swFeat.GetFirstSubFeature6 l2 O/ b9 K3 J2 g' X! T, ?7 R
Set swDispDim = swFeat.GetFirstDisplayDimension
) b1 q/ T0 E$ T6 U( Q2 T
Do While Not swDispDim Is Nothing
& |/ F O6 u) V' ?% D% D$ a
'Set swAnn = swDispDim.GetAnnotation
g$ N7 o1 I) z, [- O$ b% k% f
Set SwDim = swDispDim.GetDimension* u$ }0 v, i- m; Z! |( e
Str = SwDim.FullName '特徵樹名稱
! Q% q: f7 s$ j" [1 E+ r2 b
oArr = Split(Str, "@")
3 B& [# ~6 h9 G9 r4 s5 H& p% B- X" z6 S
Str = oArr(0) & "@" & oArr(1)4 y$ M4 }& \; ~3 d
oDic(Str) = SwDim.GetSystemValue2("")4 U6 j; x0 H" G/ J% ]* z/ S: ~. a
Set swDispDim = swFeat.GetNextDisplayDimension(swDispDim)( W3 ]$ u9 Y2 d( u
Debug.Print Str, oDic(Str) ', 符號相當於按Tab鍵
7 f4 R/ G$ m l O( G
kk = kk + 10 d( X- ^- T3 G% r& T
Loop
7 R h l* e o3 h
Set swFeat = swFeat.GetNextFeature
% D$ g8 _$ Z+ v
Loop' d9 [! j. K8 L" ~
oArr1 = oDic.keys: oArr2 = oDic.Items4 W! Z; C+ Y. h9 \. h( o, d6 @4 S
.cells(1, 1) = "Serial number": .cells(1, 2) = "Array staging": .cells(1, 3) = "Dimension name"& Q. z8 ]5 z2 R; \
.cells(1, 4) = "Feature name": .cells(1, 5) = "Dimension value"/ n, X+ f, l: R" r
For kk = 2 To UBound(oArr1) + 2& i x# P( p* i- d
.cells(kk, 1) = kk - 2! q Z/ w6 S8 i7 Y
.cells(kk, 2) = "=" & """Arr(""" & " & " & .cells(kk, 1) & " & " & """)="""
9 i6 a8 [8 p$ N& t$ F+ a
.cells(kk, 3) = "'" & Chr(34) & oArr1(kk - 2) & Chr(34)+ @3 i M( N! A6 a& p
.cells(kk, 4) = Split(oArr1(kk - 2), "@")(1) '(1)僅讀取特徵名" K r6 L# K/ p/ t+ C" ^
.cells(kk, 5) = oArr2(kk - 2)
( [0 X! ]9 z: h4 i* Q( D$ e
Next kk- k7 U1 D6 c7 d5 T; o) V: |* v
nn = .Range("C65536").End(3).Row 'End(3)==>End(xlUp)
) B4 V2 W1 J3 c3 _- n
Stop '暫停修改Excel之尺寸後,再按RUN執行鍵
5 Y5 k ^+ l. b" g( m. p" ~" `/ s
Set Part = SwApp.ActiveDoc% Y0 W w; n* R' N3 v/ t
'依據Excel變動值修改到sw零件' L2 \ K) h+ Q8 z! e% M: y& `
For mm = 2 To nn
( k5 u5 o) K/ P4 i
Size_name = Mid(.cells(mm, 3), 2, Len(.cells(mm, 3)) - 2)
: }$ U7 G0 s# M( D0 n, c4 ^( X6 i1 a
Part.Parameter(Size_name).SystemValue = .cells(mm, 5)1 D U4 Z: {; B* `
Next mm
( `/ R8 p, `/ K: B, P
End With
. R7 s& j1 v8 p) r
boolStatus = Part.EditRebuild3()
4 s8 u, `3 Z- W
MsgBox "Part size modification ends" '零件尺寸修改結束% X- j* U% ]/ A- n" A
End Sub
; C! d7 w* _7 j9 B- O2 V. ?& k

复制代码

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

本帖子中包含更多资源

点评