图号分离

呐，你要怎样

软件小白一枚，因为公司需要统一零件模板，并且和我们搭建的PDM关联，需要将文件属性写入配置待定里面。之前用图号分离宏只能把属性写入自定义信息中，配置待定中只有空的标题，分离后的内容不能读取。
下面是我在网上找的说是可以将图号分离后属性写到配置待定的代码，实际调试有错误，见红色代码。
---
4 f" N( t4 y* x/ l* dDim a As Integer
$ Y2 V! [+ |2 \
Dim b As String
( b2 \  k& \; k
. N* @5 |/ Q7 W( I" cDim m As String
& ^; u. z& |# C; M( S
. I9 e. h5 F5 S9 v4 qDim e As String

- v9 d" w- [- O. D; l! tDim k As String

Dim t As String
  z+ E) M: T: I& l2 C
* b- n; V; R. \Dim c As String
# I+ B, d+ I4 l4 t" }$ a
' @! @2 b7 `' U  XDim j As Integer
' i( |. p% h& z  H7 l$ T! i8 R
Dim strmat As String
$ v. c6 E- E5 @& f
Dim tempvalue As String
3 K( ^# G  m+ @; w+ q* B+ w
: P6 T( c% b& s* QDim Part As Object

Dim swApp As SldWorks.SldWorks

Dim swModelDoc As SldWorks.ModelDoc2

Dim swConfig As SldWorks.Configuration
5 z$ t8 D* L6 {( q  x
Dim swModel As SldWorks.ModelDoc2
1 N* P9 |, W3 d% Q7 Q/ G5 s8 f6 _
Sub main()

3 L4 _3 A9 c5 b& VSet swApp = Application.SldWorks

Set swModelDoc = swApp.ActiveDoc

Set swConfig = swModelDoc.ConfigurationManager.ActiveConfiguration

' T9 |1 \4 V; d) \. ~/ w# ESet swModel = swApp.ActiveDoc
7 Z- f( [9 z# R- [
/ m) `4 n  ?. H8 G/ t7 h0 L) ?Set CustPropMgr = swModel.Extension.CustomPropertyManager(swModel.ConfigurationManager.ActiveConfiguratio.Name) '配置特定延伸
  J2 A) ~8 y* y" B
: H) x6 h3 d4 {'设定变量
" x( E6 h9 V  [1 J3 d
. |; f/ Y" H8 h6 f: E' D  B2 Zc = swApp.ActiveDoc.GetTitle() '零件名
3 N7 W! b# t( _  w  T( B" \* _
3 U' l7 R' w" f  }* T" Qstrmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)

4 F- a; N$ P/ x% C3 B" n- T# m. ca = InStr(c, " ") - 1 '重点:分隔标识符,这里是一个空格,也可换成其他符号
5 }; B$ f% {$ o4 N6 B( B
" ]8 g0 W, z: S6 o# N, r% |% fIf a > 0 Then
8 @0 H% |' G/ `5 b& n' w. ]2 L
k = Left(c, a)
' s* s6 I; T: p0 q( Q% o" e, @7 ^
+ k; {5 v0 E8 u1 ]) ht = Left(LTrim(e), 3)

If t = "GBT" Then

7 @3 C4 G  X* H' x/ v0 a, T! ne = "GB/T" + Mid(k, 4)

Else
+ [& L3 [: C2 n
e = k
" \7 E2 w0 O4 I1 f. ~
End If

b = Mid(c, a + 2)

6 I4 a, ]3 P1 T8 |2 F1 ]) g! w$ ]t = Right(c, 7)
) K3 K0 i8 H) E3 t- w0 M1 ^
/ l' j+ O% A* q9 @If t = ".SLDPRT" Or t = ".SLDASM" Or t = ".sldprt" Or t = ".sldasm" Then

j = Len(b) - 7 '消除后缀(区分大小写,即含4种)
$ O8 m+ t" i8 p+ x, n" b) K& r& E
Else
- P; b$ ]. U/ |9 O+ D
j = Len(b)

! `! J7 [) C* PEnd If

m = Left(b, j)
: o; ?/ U0 H9 N( }! A+ B
End If
# p# [5 v' t. [
'删除栏
. q; x6 [1 o$ V
CustPropMgr.Delete ("图样代号")

' m6 M/ r3 z( R6 y! ^  BCustPropMgr.Delete ("图样名称")

0 \8 T3 u; j! vCustPropMgr.Delete ("材料")

2 B/ t& b( u. g1 ?' g( Z6 L# D'新增

5 W3 v* l; J! \/ D2 ?6 ]( RCustPropMgr.Add2 "图样代号", swCustomInfoText, e
4 [7 l7 L& n" ~  U% [
4 A  [! [( U7 N* \# ]CustPropMgr.Add2 "图样名称", swCustomInfoText, m
) b" ?' w0 ?, y6 {3 w) Q
CustPropMgr.Add2 "数量", swCustomInfoText, ""
1 E  J- K# F* F8 N; D
  ^" {" q, G4 s5 ?CustPropMgr.Add2 "材料", swCustomInfoText, strmat
1 }* l! L2 d4 @+ H) F
) a2 r. J5 r9 _' h" C* l  B5 }9 a( H0 f3 }CustPropMgr.Add2 "单重", swCustomInfoText, ""

& c. u" q7 z5 FCustPropMgr.Add2 "总重", swCustomInfoText, ""

! _$ ~" t/ v5 {( h4 }- p: LCustPropMgr.Add2 "备注", swCustomInfoText, ""
* Y- z, x7 q+ z$ e' z8 p
2 }5 z, J1 [4 C1 L3 A2 NEnd Sub
---
想请教下大拿们，这个代码要怎么修改才能管用。之前的图号分离宏，可以让所有属性出现在自定义里。或者有没有办法加一段自动复制自定义里面属性到配置待定里去的代码？

在线等大神解惑
/ v5 |: z0 j/ d
- O0 U( M9 U  h% V
. y- w/ B# n8 S

呐，你要怎样

可以用宏来实现自动复制吗，尝试录制宏，没有用

Wukui*

叫我大哥，我可以分享现货给你。。。哈哈哈哈哈

呐，你要怎样

Wukui* 发表于 2019-4-22 16:58
叫我大哥，我可以分享现货给你。。。哈哈哈哈哈

, k6 e7 g' _1 N  z7 d大哥好

金卯刀-劉

'定义sw
* L, A# X8 ]0 L. B  U! W


. x% Y+ N6 f, J. ?% PDim a As Integer

Dim b As String

Dim m As String
4 T% J0 I$ T0 u; q6 T  g
Dim e As String
3 q1 ^8 J! [* B
Dim k As String

- z# S( ~% f& sDim t As String
0 _0 R" o8 g1 P2 ?
Dim c As String

  K/ i4 Q- i: u2 P  oDim j As Integer
% v; p9 A3 f; @  e1 U
Dim strmat As String
9 e+ k1 D( R9 V, ~* l; M# N
Dim tempvalue As String
" v6 o( I* F, V  H
( e# f4 M. k" S% {Dim Part As Object
3 f6 A: H6 [% u  ~" u5 e$ L4 n
% }- j) {* W* U& O: zDim swApp As SldWorks.SldWorks

Dim swModelDoc As SldWorks.ModelDoc2
" u1 u8 o' l1 N+ O4 g8 J( u
* r% Z! h$ E4 W3 Y4 @  nDim swConfig As SldWorks.Configuration
- o* Q! ^# f0 a$ t8 E
Dim CustPropMgr As SldWorks.CustomPropertyManager

Dim swModel As SldWorks.ModelDoc2

6 x8 n" `2 g7 b: Z. \7 v3 X

Sub main()
) Q' `: R; ^0 B, _& u
) s" f* Y. M3 z$ O/ @2 D; _5 [Set swApp = Application.SldWorks

0 t5 _5 k6 T# [6 nSet swModelDoc = swApp.ActiveDoc

, E% ]7 W% c7 }+ ^Set swConfig = swModelDoc.ConfigurationManager.ActiveConfiguration

/ \# L, x: |( N" E. TSet swModel = swApp.ActiveDoc

. K7 q; w9 J3 XSet CustPropMgr = swModel.Extension.CustomPropertyManager(swModel.ConfigurationManager.ActiveConfiguration.Name) '配置特定延伸
! N9 c: S4 M2 |

4 j, ^& @; P/ Y, i
4 J) E* c8 y- j; v& n( V'设定变量

1 E, `  y) P. @! m0 ^0 Vc = swApp.ActiveDoc.GetTitle() '零件名
- ?" D/ A" T% ^0 }
+ x/ F. z9 @! K; a! jstrmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
+ Z( I% j. J) o3 H; @$ \
a = InStr(c, " ") - 1 '重点：分隔标识符，这里是一个空格，也可换成其他符号
& @. p+ C4 }  n& c8 t
If a > 0 Then

k = Left(c, a)
* {5 f# }4 R1 p# ?: V0 `/ {) j* t
/ r7 i! K. @# t% bt = Left(LTrim(e), 3)
! w* ~& G% ^( G2 J+ ?" G% S  y( @
If t = "GBT" Then
: m) Y' `6 i) }0 a: S' ]) Z; o
( s% |7 U- z1 e0 m: L3 B( e& xe = "GB/T" + Mid(k, 4)

Else

" {7 ^, ~6 a( S' y- We = k
' @' L, I6 u$ ^/ w7 ]
! \/ U* u0 `1 \End If
2 K( E6 Z' c  x$ O: Q$ K/ B
b = Mid(c, a + 2)

" i% ]- i  v+ X* H# _t = Right(c, 7)

, G0 l! C9 z$ L! h7 D5 }If t = ".SLDPRT" Or t = ".SLDASM" Or t = ".sldprt" Or t = ".sldasm" Then
" Q, _. G5 a7 y( A! O5 s! i+ U& ?
j = Len(b) - 7 '消除后缀（区分大小写，即含4种）
8 }; R, O0 z: }% ]: M
& k* A; v, ]+ t- q7 ~1 q9 \) l! dElse
' ?1 F! K7 a! G- E: j
3 [: D9 N# s! cj = Len(b)

End If
7 y' a0 ^0 m7 e$ w& S& h2 K
m = Left(b, j)

End If

'删除栏

CustPropMgr.Delete ("图样代号")

CustPropMgr.Delete ("图样名称")

; o7 Y+ H: X6 ]CustPropMgr.Delete ("材料")
4 k6 ~* n3 y5 D
. o! F/ y. L0 }3 W( q' M
+ o  v+ I+ z+ |. t$ A$ l  u
'新增
( H; w0 Y/ b& Q3 ~
CustPropMgr.Add2 "图样代号", swCustomInfoText, e
  W, u1 C& G& p  }1 G
+ A8 L9 O/ T) r2 u" dCustPropMgr.Add2 "图样名称", swCustomInfoText, m

CustPropMgr.Add2 "数量", swCustomInfoText, ""

' Z/ h1 M/ v; l8 W+ }. Z$ \% Q* CCustPropMgr.Add2 "材料", swCustomInfoText, strmat
' P/ Z( |& r8 t: j; N) S
CustPropMgr.Add2 "单重", swCustomInfoText, ""

CustPropMgr.Add2 "总重", swCustomInfoText, ""
$ X3 y! {" B  H: [$ t  x+ o/ I
: R* d6 G. e5 t, ~3 Y& T# X$ RCustPropMgr.Add2 "备注", swCustomInfoText, ""

- D4 a5 i0 b$ R
- U7 K- G( O+ W/ V
End Sub
; d& Y/ c: D7 [/ ~$ f
. ~' ~/ j! ]* L" A7 ~9 O: ~亲试管用，注意图号与名称中间间隔是“空格”

呐，你要怎样

金卯刀-劉 发表于 2019-4-22 20:15
'定义sw

8 M  H5 X1 Y) g) w# m5 A' A3 P6 k3 ?感谢大佬，实测有效。但是还是有点小遗憾，不能实现想要的功能。
$ u9 p9 I9 O* A+ L0 S! p! L----
CustPropMgr.Add2 "数量", swCustomInfoText, ""

3 _4 M/ w0 K/ D6 R
$ X3 B' P" Y7 d) t# l/ O/ C" BCustPropMgr.Add2 "材料", swCustomInfoText, strmat

----
如上面这两段代码，材料后面strmat，会直接连接零件的材质，而类似数量这样后面是双引号的，则不能链接属性。
% C( s+ e( [% q% b2 r8 l属性编辑标签在自定义和配置待定中只能选择一个，这就很尴尬了。
8 m& O- ~. N, q
不知道大佬有没有办法，可以将代码中这些信息直接链接相关属性？感谢大佬
6 s0 x' c5 U0 N5 p8 q

金卯刀-劉

呐，你要怎样 发表于 2019-4-23 09:24
1 ^1 N2 S9 q  G& |; _% j( ?感谢大佬，实测有效。但是还是有点小遗憾，不能实现想要的功能。
6 N( h+ ^; s' h' i  E  h----
CustPropMgr.Add2 "数量", swCus ...

1.有办法在配置特定里增加数量，但那是另外一个宏，是统计整个装配体里的零件自动写数量到你指定是属性名。并且是在配置特定里。
2.材质是要自己选择的，一个宏没办法写不通用的东西。如果想通用只能是关联零件材质属性例如"SW-Material"
3.不知道你用过属性模板，你需要的这些是可以通过属性模板实现的
2 |4 O3 `' `2 I3 h3 s

呐，你要怎样

金卯刀-劉 发表于 2019-4-23 15:40
1.有办法在配置特定里增加数量，但那是另外一个宏，是统计整个装配体里的零件自动写数量到你指定是属性名 ...

属性标签是有用的，但是不能同时写入自定义和配置待定，只能选一个。零件绘制完以后，材质、数量等信息就已经通过属性标签录入了，现在其实就是想让自定义里的信息同样地出现在配置待定里。
! r/ g" ?1 T/ ]9 D/ X8 y0 [因为看到大佬贴的代码里，最后Add的东西，如下：
----
7 h( Y- j- K/ V: w( t  JCustPropMgr.Add2 "图样代号", swCustomInfoText, e
3 b6 j- z! q) V4 X----
这里的e和我之前的图号分离宏里面定义的是一样的，然后运行完前一个后，再运行你发的代码，它会同样的读取e的信息，然后再配置待定里面就会出现和自定义里面一样的图样代号。只是好像不知道可不可以把其他的信息都定义为某个字母，这样是不是可以相互关联上？

feelling

看起来不错

太一OS

金卯刀-劉 发表于 2019-4-23 15:40
, V9 d7 N* D) @! P( K* e1.有办法在配置特定里增加数量，但那是另外一个宏，是统计整个装配体里的零件自动写数量到你指定是属性名 ...

你好，请问一下图号分离能实现三段分离吗？比如图号 图名 备注
  I  h- E, ^2 l