SOLIDWORKS 宏合并执行的问题

ryouss · 发表于 2018-11-25 11:32:35

就是如下的繁体字改為簡体字就是

' ******************************************************************************+ f; `3 w9 Y. {! T& Q6 R, ~' r' d$ t
' C:\Users\admin\AppData\Local\Temp\swx8144\Macro1.swb - macro recorded on 11/22/18 by mqlu
2 W) X/ }& O6 x7 M- W& q* y7 `
' ******************************************************************************( m" L2 ] C- L: ]5 B) s
Dim swApp As Object) R( \+ z/ c+ `4 b
Dim Part As Object
# ^4 j) Z. s m; N7 o
Dim boolstatus As Boolean3 G3 x/ o, B* l# Y% |
Dim longstatus As Long, longwarnings As Long
1 i9 f# K4 E+ e3 z: I! s6 _
+ Q! X: D; |0 O$ ]9 p* S
Dim SelMgr As Object
' J6 J0 |* M6 [3 I; y3 ?
Dim Feature As Object
5 s, H$ G" v, f" G N
Dim a As Integer
- |, n5 \$ F% ~8 Z/ Z! z
Dim b As String
& O, t5 w1 o6 g6 ]
Dim m As String- I+ ] J. h E# ?! ?) F6 }9 b- J2 L! E" R
Dim e As String
5 \2 k% t$ j' J. \1 t. s
Dim k As String
: M% {) T) {* Q# j. C+ d6 r
Dim t As String5 ]) p* \4 O- |9 k5 c
Dim c As String
/ y7 @0 B9 p2 m1 u
Dim j As Integer
' T, y% Y9 b( }
Dim strmat As String5 a9 {! G2 [. o; F$ e/ E
Dim tempvalue As String7 d- `/ `2 ]0 m' t2 k
3 z% x. l# ?1 K1 t+ R
Sub main() '刪除所有配置屬性
$ F) u5 Z5 _- O! V- s C
Set swApp = Application.SldWorks
- g" n4 ]/ E! t; ^, u
Set Part = swApp.ActiveDoc
; T5 m4 w: Y3 z
CurCFGname = Part.GetConfigurationNames& I$ D2 H+ O) s' k8 ?* p" M& `
CurCFGnameCount = Part.GetConfigurationCount
) {% p3 U: @/ d. z! Y6 H0 _
For i = 0 To CurCFGnameCount - 1% [1 ?' [# o3 O/ Q
Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
0 \/ b* f+ Z8 B" l' J2 o4 ^2 g
Vnamearr = CusPropMgr.GetNames7 l! p+ n- O* d3 s) L; I1 x
If Not IsEmpty(Vnamearr) Then+ m! D- U' k$ ^. k. {. j7 |5 Q
For Each Vnamearr2 In Vnamearr- q, q+ Y; e$ e
bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)0 e8 L" d2 v5 j* [2 ]: H
Next7 c; y6 K( x/ R5 L
End If i4 o% f* ?, M W5 @$ |+ b
Next9 v8 h& ~ r" G) F& k! c. I, S
Call 刪除自定義屬性% h* J: ^) j8 d: }1 `! L$ Q
Call partitionTM
& j, d2 H7 P* M/ b+ T$ Q# z
2 Y5 i. K5 t0 A# M
End Sub$ N0 Q: |9 V) M2 ^$ V
" m4 A$ Y) @, j0 Q* B
'~~~ 刪除自定義屬性 ~~~
: S4 n3 Y; c; O5 S6 ~* E9 V
Sub 刪除自定義屬性()
6 t& k7 s8 m0 ]3 ]
'Dim swApp As Object* {4 O) w# n: H5 q3 {
Dim swModel2 As SldWorks.ModelDoc29 _ t9 ]" M y
Dim vCustInfoNameArr2 As Variant
' b* W! n+ A5 ?! ^1 s, s
* }7 x$ o, [* s' R
Set swApp = Application.SldWorks
+ U7 X' d7 B2 t' X' d8 T. ]
Set swModel2 = swApp.ActiveDoc
A3 |; s$ _8 ~+ y- z, _" ~
vCustInfoNameArr2 = swModel2.GetCustomInfoNames
0 ~4 N2 g1 V, I0 u
If Not IsEmpty(vCustInfoNameArr2) Then/ k d& x6 c& g2 s/ `( e# v( }* I$ G
For Each vCustInfoName2 In vCustInfoNameArr28 G1 @+ ?1 u8 n! Y+ h! j3 v6 d J. k
bRet = swModel2.DeleteCustomInfo(vCustInfoName2)" v5 \3 A" z) G' p
Next j$ ]5 d3 F0 i
End If4 C7 B. o1 i/ `) |- n, z+ ?4 o
End Sub
G! b a6 ~' @
, L7 u9 F) I! Q; o& O9 y
'~~~ partitionTM ~~~
$ i; x1 O0 f% i" q7 r$ ?2 r
Sub partitionTM() 'partitionTM) r. V/ c# ~* w* x0 K
0 Y9 u' g& F/ Y9 H3 ?# _4 a4 J
'link solidworks
% q1 w2 D- n& R( g, \
Set swApp = Application.SldWorks3 p* l* M$ E6 N- Z' ~+ Y1 z
Set Part = swApp.ActiveDoc
# N/ `4 B. I, N) C8 p
Set SelMgr = Part.SelectionManager
/ z4 n5 |4 F$ q+ m8 W/ {/ f2 P
swApp.ActiveDoc.ActiveView.FrameState = 1
& s- B- I6 g) I }) G
'設定變量& A- r6 P. `) S3 b$ [7 {+ t
c = swApp.ActiveDoc.GetTitle() '零件名
3 J& a2 E7 a( U
strmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
* D5 ~9 r8 h y& [. c; E" |5 Z! r
'tempvalue = Part.CustomInfo2("", "材料")
% v; z8 X; i# x' G3 E/ c; T' {
blnretval = Part.DeleteCustomInfo2("", "代號")
+ }; K) D1 v* U }, P* l! f
blnretval = Part.DeleteCustomInfo2("", "名稱")
- d" i# T- S: O$ q( L
blnretval = Part.DeleteCustomInfo2("", "材料")
+ ] p5 ~3 E6 U* l
a = InStr(c, " ") - 1( O$ s5 X! m- u; _" T
If a > 0 Then
3 Z% y/ O `) Q9 q/ V" J
k = Left(c, a)1 {, O- V# O6 K1 H. [9 ?8 F; }- @& f
t = Left(LTrim(e), 3)' i: h) b7 c& [
If t = "GBT" Then
e = "GB/T" + Mid(k, 4)' ]8 T- {; q9 R; C4 V( c, `3 B k
Else) R! D" ?1 ]7 y U/ A
e = k( L; {! h6 S. B, n$ O3 n
End If/ I* J9 o8 B* x+ l
b = Mid(c, a + 2)
. T" N- [ k/ Q1 ]5 a' ^" X1 L
t = Right(c, 7)
9 O3 ~( T) s& @7 }1 R+ {
If t = ".SLDPRT" Or t = ".SLDASM" Then$ T1 |/ P! B! K
j = Len(b) - 7/ a7 \/ _& @2 w' a, }. Y5 ?
Else7 I! N0 Q) W5 v: f
j = Len(b)
0 ^; Y, C' F" e$ a! L& m, d N
End If G1 S5 g) \2 i
m = Left(b, j) q l+ s6 n R; V) `6 s. M& b
End If* R- [' A$ `) }# H2 W
blnretval = Part.AddCustomInfo3("", "代號", swCustomInfoText, e)
2 @0 D7 _) h+ T; }1 X& _% q
blnretval = Part.AddCustomInfo3("", "名稱", swCustomInfoText, m)
: A3 w9 k4 \' V0 ~$ Q
blnretval = Part.AddCustomInfo3("", "材料", swCustomInfoText, strmat)
- Q* A; w0 I" S: t4 R6 e! T
blnretval = Part.AddCustomInfo3("", "單重", swCustomInfoText, " ")
3 A8 {! B8 z5 k
blnretval = Part.AddCustomInfo3("", "備註", swCustomInfoText, " ")
+ ], \' S5 o4 a- ^- R
. d/ X( h2 u- x$ U: D
End Sub

复制代码

arter_2006 · 发表于 2018-11-26 15:11:45

ryouss 发表于 2018-11-25 11:32
8 `' C3 x6 J% }/ h% E) Y' [就是如下的繁体字改為簡体字就是

执行后无反应，属性都没改，不知道问题出在哪里？让您费心了。

' ******************************************************************************
' C:\Users\admin\AppData\Local\Temp\swx8144\Macro1.swb - macro recorded on 11/22/18 by mqlu
' ******************************************************************************
Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long

Dim SelMgr As Object
Dim Feature As Object
Dim a As Integer
Dim b As String
Dim m As String
Dim e As String
Dim k As String
Dim t As String
Dim c As String
Dim j As Integer
Dim strmat As String
Dim tempvalue As String

Sub main() '刪除所有配置属性
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
CurCFGname = Part.GetConfigurationNames
CurCFGnameCount = Part.GetConfigurationCount
For i = 0 To CurCFGnameCount - 1
Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
Vnamearr = CusPropMgr.GetNames
If Not IsEmpty(Vnamearr) Then
      For Each Vnamearr2 In Vnamearr
         bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
      Next
End If
Next
Call 刪除自定义属性
Call partitionTM

End Sub

'~~~ 刪除自定义属性 ~~~
Sub 刪除自定义属性()
'Dim swApp As Object
Dim swModel2 As SldWorks.ModelDoc2
Dim vCustInfoNameArr2 As Variant

Set swApp = Application.SldWorks
Set swModel2 = swApp.ActiveDoc
vCustInfoNameArr2 = swModel2.GetCustomInfoNames
  If Not IsEmpty(vCustInfoNameArr2) Then
   For Each vCustInfoName2 In vCustInfoNameArr2
      bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
   Next
  End If
End Sub

'~~~ partitionTM ~~~
Sub partitionTM() 'partitionTM

'link solidworks
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
Set SelMgr = Part.SelectionManager
swApp.ActiveDoc.ActiveView.FrameState = 1
'设定变量
c = swApp.ActiveDoc.GetTitle() '零件名
strmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
'tempvalue = Part.CustomInfo2("", "材料")
blnretval = Part.DeleteCustomInfo2("", "代号")
blnretval = Part.DeleteCustomInfo2("", "名称")
blnretval = Part.DeleteCustomInfo2("", "材料")
a = InStr(c, " ") - 1
If a > 0 Then
k = Left(c, a)
t = Left(LTrim(e), 3)
If t = "GBT" Then
      e = "GB/T" + Mid(k, 4)
Else
      e = k
End If
b = Mid(c, a + 2)
t = Right(c, 7)
If t = ".SLDPRT" Or t = ".SLDASM" Then
      j = Len(b) - 7
Else
      j = Len(b)
End If
m = Left(b, j)
End If
blnretval = Part.AddCustomInfo3("", "代号", swCustomInfoText, e)
blnretval = Part.AddCustomInfo3("", "名称", swCustomInfoText, m)
blnretval = Part.AddCustomInfo3("", "材料", swCustomInfoText, strmat)
blnretval = Part.AddCustomInfo3("", "单重", swCustomInfoText, " ")
blnretval = Part.AddCustomInfo3("", "备注", swCustomInfoText, " ")

End Sub

ryouss · 发表于 2018-11-26 16:58:44

本帖最后由 ryouss 于 2018-11-26 17:04 编辑

arter_2006 发表于 2018-11-26 15:11
$ Q% q0 |( x6 n: J( I执行后无反应，属性都没改，不知道问题出在哪里？让您费心了。
' j1 a: G1 b q% T1 R0 o5 B- _7 ]% ]# q5 F% t' [6 Z+ u0 i$ ]3 R2 A
' ********************************** ...

sw2017 測試OK
有否顯示什麼錯誤提示?

arter_2006 · 发表于 2018-11-26 17:00:36

我的是Solidworks 2018，看来可能是版本的问题了

ryouss · 发表于 2018-11-26 17:05:55

arter_2006 发表于 2018-11-26 17:00
2 [7 G ^- k x! A我的是Solidworks 2018，看来可能是版本的问题了

2018 沒版本能試

arter_2006 · 发表于 2018-11-26 17:19:04

ryouss 发表于 2018-11-26 17:05
0 @7 M! T. v1 `5 L6 f4 J2018 沒版本能試

非常感谢您，让您费心了。

arter_2006 · 发表于 2018-11-26 17:27:57

ryouss 发表于 2018-11-26 17:05 J0 z# k$ q$ y1 y& b* e# J& @5 u9 N
2018 沒版本能試

能否把您的SWP文件发上来，我刚才用solidworks 2014也试了一下，发现也不行，但是别的宏都可以。
我从网页上复制下来的都变成下面这个样子了，所以要删掉很多多出来的东西，我怀疑是不是这个原因导致的，但是校对很费时间，也难发现。

' ******************************************************************************3 \3 X) J3 n, I6 @4 |0 x
' C:\Users\admin\AppData\Local\Temp\swx8144\Macro1.swb - macro recorded on 11/22/18 by mqlu' a$ M. \3 S6 C, S! A1 C
' ******************************************************************************
: n% $ F) I, C+ j: _& m6 bDim swApp As Object
' e* i- B# F; m% [6 c9 t+ \0 }Dim Part As Object! t9 ?1 q2 c' K2 l9 ^4 X" G
Dim boolstatus As Boolean- I8 s/ Y$ i' W. N0 _
Dim longstatus As Long, longwarnings As Long
1 W8 u' q( \3 d4 Y/ K1 v" N; D
3 J( R9 \8 _3 m& $ d/ \Dim SelMgr As Object
: S& D4 E8 I: d4 K4 q9 f0 e& f5 HDim Feature As Object
7 s$ z: N6 b! v  l! SDim a As Integer
& P" q% F6 [5 U$ N  F7 l5 _1 iDim b As String/ a) E' o9 v7 y0 L) H; T4 a/ J& Z% M
Dim m As String+ ?/ w( `) D: S9 x
Dim e As String" t" l1 k  K7 K8 U: @# s; `
Dim k As String* ?4 t9 u7 n+ _
Dim t As String
% R* ?6 C5 B( @3 D& DDim c As String
! K3 d. @4 X+ d/ Q. _. p: yDim j As Integer3 N( z+ v  K2 q* v6 D
Dim strmat As String
" F! d7 t6 p- DDim tempvalue As String
& E& r" D5 F  G0 |% Q: b, Y
- o) ?$ `2 a( G& L5 x7 Q- B3 Z( ISub main() '刪除所有配置屬性
; c8 H3 l/ z* n* R9 KSet swApp = Application.SldWorks9 g. p. p7 K6 u7 ?4 x4 W6 n
Set Part = swApp.ActiveDoc$ q6 |& ^2 b7 ~/ ]( ^0 R
CurCFGname = Part.GetConfigurationNames
- [5 v: x. U8 U( V* kCurCFGnameCount = Part.GetConfigurationCount
" c- O# J: c, c5 w7 Y0 T. @for i = 0 To CurCFGnameCount - 1& {$ V* E/ x+ ~. V
Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
. G( J! L$ ?  c% B6 } Vnamearr = CusPropMgr.GetNames4 B$ N4 Q* X) q- [; f8 r0 ^5 {
If Not IsEmpty(Vnamearr) Then' t" n; u" h( T
      For Each Vnamearr2 In Vnamearr
- n8 t& |, B: B/ V9 S4 d, F7 Z          bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)+ h. {$ P6 Q5 M: i
      Next- P& E; Z$ s7 V+ a( t' E% T
End If
$ A3 @6 S" n' d2 eNext
  k" k4 f; K$ vCall 刪除自定義屬性
( A- x) f" C" d8 G6 }) {# {' iCall partitionTM4 }2 o$ e' E7 t

2 @8 q. ~" b  {% q" `4 h6 {End Sub
% e; G6 r) ]# @' p
" D7 r# [' m2 U5 Z7 k9 B. O: ?'~~~ 刪除自定義屬性 ~~~
: Q6 `! G2 u. ]" |4 i. ?Sub 刪除自定義屬性()
  B# r$ |5 d2 b. o4 x5 W" n+ J'Dim swApp As Object2 Q# s7 O1 ~+ I" }
Dim swModel2 As SldWorks.ModelDoc2
! f' g# o6 S, e, W4 z+ EDim vCustInfoNameArr2 As Variant7 J* i  U% A! t0 \0 D! h, V

- K" x+ X- v- E% b! h6 i* p! ], |9 USet swApp = Application.SldWorks
4 S  i4 [' W6 ]0 I* U0 V' O' B+ NSet swModel2 = swApp.ActiveDoc3 u) Z+ D2 D4 z; M# d4 {
vCustInfoNameArr2 = swModel2.GetCustomInfoNames- N/ C9 m0 n2 t* k9 u
  If Not IsEmpty(vCustInfoNameArr2) Then
! V# Z5 s; g8 P9 J( v  m% Z    For Each vCustInfoName2 In vCustInfoNameArr2- \% O7 w% [: r; T3 |5 M
      bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
. ?" R/ r# I! y' x7 _' X    Next9 U+ R% V2 G# P
  End If
& V, L( M& Q4 l& b0 TEnd Sub
6 M- K7 `: z' w) T+ c$ V; G
/ j9 |  ?( U5 a+ K'~~~ partitionTM ~~~7 O3 t. l4 R1 [+ ]3 K  G+ M
Sub partitionTM() 'partitionTM( j# ]! b. Q, G0 M9 E4 f8 B2 J
% l; E) x# ~4 [& t0 {8 [
'link solidworks( C, c- [# N+ Z* [
Set swApp = Application.SldWorks+ w1 D3 {4 b7 ^# i5 p4 ~2 p
Set Part = swApp.ActiveDoc
) k" c8 Y, z+ b# A0 `9 OSet SelMgr = Part.SelectionManager% m# Z: n! Q: I/ M* d( j' c
swApp.ActiveDoc.ActiveView.FrameState = 1& ?6 I  _. Y+ \4 m7 P" c% W/ h
'設定變量& }. N& d* J$ W) S
c = swApp.ActiveDoc.GetTitle() '零件名
. {8 L5 ~" z0 y# g! I" Estrmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34). w+ f3 v( W- `* D! G! v. z
'tempvalue = Part.CustomInfo2("", "材料")
& U; y& P! d9 n  V  X0 H+ J1 Yblnretval = Part.DeleteCustomInfo2("", "代號")3 w1 A4 Q. Z1 \, x1 N/ e; R
blnretval = Part.DeleteCustomInfo2("", "名稱"). }" r" K0 E! E
blnretval = Part.DeleteCustomInfo2("", "材料")
+ U) d- F; R- ]4 V0 e- k2 J; Sa = InStr(c, " ") - 1
" v0 S% D. r) K$ `' iIf a > 0 Then
0 D& _% k+ M" K3 ~ k = Left(c, a)0 D( T  G4 u* @' Z: h# g5 h) k
t = Left(LTrim(e), 3)0 |: d+ H% K1 I5 d; ^& r
If t = "GBT" Then0 a: k4 H  }1 j) y
      e = "GB/T" + Mid(k, 4)0 C& x4 F4 D' ], i* s8 T
Else
! W2 i7 C- b( f1 H* X4 B; P       e = k& O7 M7 ]$ E: v$ n5 ]  ?0 p$ z
End If! C- h9 R! k; n% D6 G+ S; P
b = Mid(c, a + 2)
1 a, _" o% b/ ^0 j8 S  T t = Right(c, 7)
( H6 S2 ?' U+ d5 X" f: a If t = ".SLDPRT" Or t = ".SLDASM" Then
( m# n+ r. ]5 p& Q/ I! e       j = Len(b) - 7: f; _- _+ L% W8 E) q2 `; Z9 B' \
Else& f9 y# D- W/ Y! i& w- H
      j = Len(b); J( ?# E, |  ?
End If8 @/ x5 s, N; \. _& V# V
m = Left(b, j)
. P: e' A' P) l4 b& \End If( o3 u- a' n" g; c4 t2 s& ]
blnretval = Part.AddCustomInfo3("", "代號", swCustomInfoText, e)
: F  K  N' M% L5 C4 Hblnretval = Part.AddCustomInfo3("", "名稱", swCustomInfoText, m)7 a/ m( J8 q$ B) ^& B( M# Q' V
blnretval = Part.AddCustomInfo3("", "材料", swCustomInfoText, strmat)
9 Z0 O2 e0 Q6 cblnretval = Part.AddCustomInfo3("", "單重", swCustomInfoText, " ")
  V; G2 e# V. L; H; {2 wblnretval = Part.AddCustomInfo3("", "備註", swCustomInfoText, " ")
: i2 D6 }7 z- @1 t: i# Q, P, {! f% c" J- {6 u; t
End Sub

ryouss · 发表于 2018-11-26 18:42:16

arter_2006 发表于 2018-11-26 17:27
4 z3 y$ y7 a% m7 J9 R, E能否把您的SWP文件发上来，我刚才用solidworks 2014也试了一下，发现也不行，但是别的宏都可以。
2 z2 J+ L' n H: q/ T+ I V我从网 ...

附swp繁体版

ryouss · 发表于 2018-11-27 13:26:40

本帖最后由 ryouss 于 2018-11-27 13:31 编辑

試試把 CurCFGname = swApp.GetConfigurationNames

改為 CurCFGname = swApp.GetConfigurationNames(swApp.ActiveDoc.GetPathName) '補加零件文件的路徑及名稱

在沒補加 (swApp.ActiveDoc.GetPathName) 時在2012及2015版是會有提示錯誤的(如附图)
另VBA編程在 " ' " 符號后的文字是會跳過不執行的.

arter_2006 · 发表于 2018-11-28 13:49:36

我试过了，改之前，改之后一个样，而且

执行中没有任何错误提示。
' ******************************************************************************
' C:\Users\admin\AppData\Local\Temp\swx8144\Macro1.swb - macro recorded on 11/22/18 by mqlu
' ******************************************************************************
Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long

Dim SelMgr As Object
Dim Feature As Object
Dim a As Integer
Dim b As String
Dim m As String
Dim e As String
Dim k As String
Dim t As String
Dim c As String
Dim j As Integer
Dim strmat As String
Dim tempvalue As String

Sub main() '刪除所有配置属性
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
CurCFGname = swApp.GetConfigurationNames(swApp.ActiveDoc.GetPathName) '补加零件文件的路径及名称
CurCFGnameCount = Part.GetConfigurationCount
For i = 0 To CurCFGnameCount - 1
Set CusPropMgr = Part.Extension.CustomPropertyManager(CurCFGname(i))
Vnamearr = CusPropMgr.GetNames
If Not IsEmpty(Vnamearr) Then
      For Each Vnamearr2 In Vnamearr
         bRet = Part.DeleteCustomInfo2(CurCFGname(i), Vnamearr2)
      Next
End If
Next
Call 刪除自定义属性
Call partitionTM

End Sub

'~~~ 刪除自定义属性 ~~~
Sub 刪除自定义属性()
'Dim swApp As Object
Dim swModel2 As SldWorks.ModelDoc2
Dim vCustInfoNameArr2 As Variant

Set swApp = Application.SldWorks
Set swModel2 = swApp.ActiveDoc
vCustInfoNameArr2 = swModel2.GetCustomInfoNames
  If Not IsEmpty(vCustInfoNameArr2) Then
   For Each vCustInfoName2 In vCustInfoNameArr2
      bRet = swModel2.DeleteCustomInfo(vCustInfoName2)
   Next
  End If
End Sub

'~~~ partitionTM ~~~
Sub partitionTM() 'partitionTM

'link solidworks
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
Set SelMgr = Part.SelectionManager
swApp.ActiveDoc.ActiveView.FrameState = 1
'设定变量
c = swApp.ActiveDoc.GetTitle() '零件名
strmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
'tempvalue = Part.CustomInfo2("", "材料")
blnretval = Part.DeleteCustomInfo2("", "代号")
blnretval = Part.DeleteCustomInfo2("", "名称")
blnretval = Part.DeleteCustomInfo2("", "材料")

a = InStr(c, " ") - 1
If a > 0 Then
k = Left(c, a)
t = Left(LTrim(e), 3)

If t = "GBT" Then
      e = "GB/T" + Mid(k, 4)
Else
      e = k
End If

b = Mid(c, a + 2)
t = Right(c, 7)
If t = ".SLDPRT" Or t = ".SLDASM" Then
      j = Len(b) - 7
Else
      j = Len(b)
End If
m = Left(b, j)
End If

blnretval = Part.AddCustomInfo3("", "代号", swCustomInfoText, e)
blnretval = Part.AddCustomInfo3("", "名称", swCustomInfoText, m)
blnretval = Part.AddCustomInfo3("", "材料", swCustomInfoText, strmat)
blnretval = Part.AddCustomInfo3("", "单重", swCustomInfoText, " ")
blnretval = Part.AddCustomInfo3("", "备注", swCustomInfoText, " ")

End Sub

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

SOLIDWORKS 宏合并执行的问题

本帖子中包含更多资源

本帖子中包含更多资源

点评

本帖子中包含更多资源

本帖子中包含更多资源

点评