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

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

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

ryouss 发表于 2019-7-6 11:508 ~! q% _9 U# C' ]
什麼版本測試的,顯示什麼錯誤提示?

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
1 D' I4 U' p k# C- s. k. x0 A

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

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

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

zmztx 发表于 2019-7-8 14:482 c g0 z6 @6 o2 u
SW2016，还没有装好
5 w+ k- h7 Z# \5 n刚开始，看到最上面的代码

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

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

'~~~~~~~~~~~~~~~~~~ 2019/07/06 V19070601 ~~~1 r! q) l( i. M( l7 @
' 操作:
! y8 B4 z/ J. j1 I, ^! T
' 1. 開 EXCEL文件.
* e- N" P8 B$ |5 q4 I
' 2. 開 SW零件.. s' E6 Z+ Z+ C& b9 q; a
' 3. 執行 ReadSwDimensionInSldPrt().& i. e5 v6 d0 i& {& c
' 4. 在EXCEL修改尺寸.$ n- Y5 @/ Q& s: ]7 o% b
') \( [/ [9 O' y4 v
' 功能:
: o" e9 o- c; X$ y9 {& Z+ M6 K
' 1. 讀取SW零件的全部尺寸,寫到 Excel.
9 K% y6 n$ N" u! Z y" }
' 2. 在Excel變動尺寸后,修改SW的零件尺寸.
3 o: V6 J+ q, e8 {+ ~4 u @
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
! X; {. r* K. v E
$ H8 B: f! e, }
Dim SwApp As Object
0 i. i+ ]; t# B" {. }! J/ M
Dim boolStatus As Boolean3 C0 \8 }, R9 _& w, `# I
Dim swFeat As Object ', swSubFeat As Object
% j; x" V$ x. g7 g0 M# C
Dim swDispDim As Object, SwDim As Object
" L# F; M5 {* U k! r
Dim Str
3 y9 V7 c4 j6 O. K. l; I5 _8 ?
Dim oDic" X$ G6 j' L. d5 j7 Z x2 \
Dim oArr1, oArr22 i& [4 J$ c5 b
* ~- L) M7 L8 l4 H( Q$ p( |! }
Sub ReadSwDimensionInSldPrt()
( q" o" h- o' [/ i8 ?$ M
'讀取SW的全部尺寸
! y1 @: L9 G0 L2 B
Set SwApp = Application.SldWorks
8 S% b* Y* T8 M. w' F( C2 ]6 q# V
Set Part = SwApp.ActiveDoc
7 S( b% T$ Z4 ^! B! ~/ u
Set oDic = CreateObject("Scripting.Dictionary"), \$ @9 y- ^! o" \$ O2 y
'*** Get active sheet in Excel
+ y- \2 f9 `5 [$ U2 ~7 v M7 z
Set xl = GetObject(, "Excel.Application")
. ]$ }0 G% a, g
With xl.ActiveSheet1 o; S0 m$ r [! U" e7 R
Set swFeat = Part.FirstFeature' A/ |, T& _' |. G& v
kk = 1
, Z5 K% N) G' U5 o6 | m: {
Do While Not swFeat Is Nothing
+ h5 z, T& n8 T! z3 z
Debug.Print " " + swFeat.Name
, [; ^3 [5 b& ~% w( H5 Y6 L) n( p
'Set swSubFeat = swFeat.GetFirstSubFeature
2 Y r0 z) {# m) A2 w! u
Set swDispDim = swFeat.GetFirstDisplayDimension
- b8 N0 c6 E0 u; w, Z% T( m. h
Do While Not swDispDim Is Nothing3 y" w& o2 ~% X$ U
'Set swAnn = swDispDim.GetAnnotation
0 I& |0 v7 h& }0 s9 p& `
Set SwDim = swDispDim.GetDimension
. [5 y, n# J3 W3 b
Str = SwDim.FullName '特徵樹名稱3 \( T- k' }# Z
oArr = Split(Str, "@")
6 ]2 c z8 L P8 S% t l
Str = oArr(0) & "@" & oArr(1)' \9 D5 T/ |; e, K' R% F- ?1 H+ a
oDic(Str) = SwDim.GetSystemValue2("")7 Y2 y+ z* ?+ d9 U- n5 Y% k& ~
Set swDispDim = swFeat.GetNextDisplayDimension(swDispDim)
5 }( d5 g- k6 d" W' E) M
Debug.Print Str, oDic(Str) ', 符號相當於按Tab鍵# _7 q3 g: ?2 C$ u. }. _+ p
kk = kk + 1! \* o$ k) X7 H: D7 s
Loop
! T1 P5 h3 ~# E% a. G
Set swFeat = swFeat.GetNextFeature
! ^$ e+ z: f2 a! e
Loop
0 t/ I7 P$ L* w! ~' S
oArr1 = oDic.keys: oArr2 = oDic.Items0 h- F' E) s0 u- P4 _2 d$ ^5 N
.cells(1, 1) = "Serial number": .cells(1, 2) = "Array staging": .cells(1, 3) = "Dimension name"
, x# z) |% B4 `
.cells(1, 4) = "Feature name": .cells(1, 5) = "Dimension value"( l: {- M% W/ x/ Q3 l0 t# F) j5 f' F
For kk = 2 To UBound(oArr1) + 2# O# x$ l$ `1 z" A7 u9 P2 {
.cells(kk, 1) = kk - 2
9 Q& W3 B- v: D% W7 X; f4 F
.cells(kk, 2) = "=" & """Arr(""" & " & " & .cells(kk, 1) & " & " & """)=""", L6 X; e4 S% a8 Y
.cells(kk, 3) = "'" & Chr(34) & oArr1(kk - 2) & Chr(34)! a3 V# m+ T( G) P6 R" f
.cells(kk, 4) = Split(oArr1(kk - 2), "@")(1) '(1)僅讀取特徵名
" x8 d; E$ i# P7 S6 H/ G
.cells(kk, 5) = oArr2(kk - 2)# H! M8 `6 v+ S5 E1 l0 l
Next kk* k2 k8 V* A- n1 Z2 Z# A
nn = .Range("C65536").End(3).Row 'End(3)==>End(xlUp)
, [8 R0 A0 y. N
Stop '暫停修改Excel之尺寸後,再按RUN執行鍵% n# j5 c, m! {; r* M5 ]8 h: C
Set Part = SwApp.ActiveDoc8 }$ W9 {( x7 w: a
'依據Excel變動值修改到sw零件
% {( }' e# D# C1 A0 m4 x
For mm = 2 To nn# q& {2 ~4 S: Z1 Q+ `
Size_name = Mid(.cells(mm, 3), 2, Len(.cells(mm, 3)) - 2)
) j; h% Y- y' p/ D6 W" U
Part.Parameter(Size_name).SystemValue = .cells(mm, 5)# b, |. i1 O- `, _
Next mm9 f+ ]& q* B( N3 w* k# l
End With
' K, T1 W/ P' {) c1 ^
boolStatus = Part.EditRebuild3()
/ I- ?+ C+ Q/ G
MsgBox "Part size modification ends" '零件尺寸修改結束& `# V6 o( i" g
End Sub+ M* B2 [" C' w9 ?. a9 v8 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零件尺寸-宏的練習

本帖子中包含更多资源

点评