装配体的名称图号分离宏修改

秋韵舞-江枫

! w( V3 S" v+ n9 {! `# z各位大大，我手上有一个名称图号分离宏，对零件来说，非常好用，装配体也可以，就是装配体下的子装配和零件还得一个一个手动去运行，能不能改成遍历所选的装配体，连同装配体、子装配、零件一起修改，因本人不懂宏，我想请论坛里的高手大大们帮我修改一下，能在装配体的模式下用，现在只能在零件的模式下用，请高人出手，谢谢！！！文件名称图号命名规则：图号+空格+名称
下面是宏文件：

8 F. C, s+ V! F; g7 v, H$ f8 ]) C

3 J/ k" R( y6 U/ q 名称图号分离.rar (8.42 KB, 下载次数: 158)

2017-8-10 11:57 上传

点击文件名下载附件



7 b, E4 P4 ~% p5 A# m

ryouss

有個簡單的宏,在裝配体執行效果如图是否適用?
: U* I) D7 R+ `$ s/ q% f; U

NC@jiang@nan

我在SW2016下测试你的这个宏在装配体下能正常使用

秋韵舞-江枫

+ o4 E2 ?; [7 n' d: h

ryouss 发表于 2017-8-10 15:46
有個簡單的宏,在裝配体執行效果如图是否適用?

谢谢梁大回复，这个宏对名称和图号长度在限制吗？另请教一下这个宏能在装配体的状态下连装配体及装配体下子装配和零件一起修改吗。

秋韵舞-江枫

NC@jiang@nan 发表于 2017-8-10 20:28
9 m+ K" U5 r# e我在SW2016下测试你的这个宏在装配体下能正常使用

& C( x$ k/ g" C. z4 o" }N大可能误会我的意思了，可以修改装配体的名称图号，我的意思是在装配体的模式下，运行此宏，连装配体本身及子装配和零件一起修改！

o1ojacko1o

楼主的 想法是 把 图号分离宏 嵌套进 遍历宏中去
1 i' _: H" W; P( N6 c; E0 T执行遍历宏之后   会遍历装配体中的每一个 子装配  每一个零件
这个可能要你自己 研究研究 VBA相关的东西了

287636713

7 }- K6 O& o+ J2 g) l" h( B% w俺只会笨方法，仅供参考。
. s/ t! w8 m8 C1.利用网络上大大分享的批量修改属性工具，打开所有需要修改的零件及组件档案；
# o+ x! }; j# v" G$ ^2.利用Excel数据》分列工具，将档案名称进行分列处理；


3.批量写入需要导入的属性（如图号&名称）
$ a- ]4 m7 ~  ?5 @) d& T" H# }
* D7 h6 N2 s3 v2 ~$ z
" ?4 W7 T) ]2 S3 a9 fps; 免责申明：非原创，俺从别处学回来的。
7 T2 O) V* ]3 N/ x+ a. x
: w0 M6 L9 H8 B4 v) i+ E
' f& w' {" q: c  x
& E3 ]. N& i. E7 g  f4 F# p

大鹿

287636713 发表于 2017-8-11 14:48
俺只会笨方法，仅供参考。
1.利用网络上大大分享的批量修改属性工具，打开所有需要修改的零件及组件档案； ...

感谢28同学献出自己的龟宿

ryouss

參考眾大師的結晶,稍加整理一下,因沒經大批量及大容量的組件測試過,
所以建議僅在小批量及小容量的組件試試看了!
' J5 @2 _  q& q/ ^+ n+ }
執行效果如附图.
$ V) f" d. x( |- u: O- ]' Q

2 L! U" ~5 _" o  W# q$ i
/ |% e9 ?* q: }8 b, A  n
  j7 K! I. |9 n/ G- B/ G
$ U7 A" E& V3 H( U0 Z

1. ' ******************************************************************************
   / V* K3 n: t! Z. A, L: P% I# }
2. '  macro recorded on 08/11/17 by lsc
   
3. '
   
4. '  組合件及零件自訂屬性名稱.
   
5. '
   
6. '  本例之編號名稱是以 "_" 之符號分隔.
   
7. '
   
8. ' 1. 把組件及零件置放在 "同文件路徑" 下
   $ p' }+ y! [8 O' C
9. '
   
10. ' 2. 開組件,執行 main 宏
    % t) p5 z5 v2 S- g0 s' B3 Q
11. '
    
12. ' ******************************************************************************
    
13. Dim TopDocPathOnly As String
    8 t0 M: c" |& L  J/ l" D
14. Dim swModel As SldWorks.ModelDoc2
    ' Z9 U) L; @. l+ l# @; ?- R
15. Dim swApp As SldWorks.SldWorks
    0 P" f" O5 }. ^3 L
16. Dim longstatus As Long, longwarnings As Long
    
17. 
    ( n  G! L+ p( j: b
18. Sub main()
    
19. Set swApp = Application.SldWorks
    & W% v9 Y" Q" r
20. Set TopDoc = swApp.ActiveDoc '總裝對象
    
21. If TopDoc.GetType <> 2 Then
    3 g5 R3 N( f3 z+ t
22.     MsgBox ("Open Assembly")
    
23.     Exit Sub '不是裝配=退出
    
24. End If
    
25. TopDocPathSplit = Split(TopDoc.GetPathName, "") '分割
    
26. TopDocName = TopDocPathSplit(UBound(TopDocPathSplit)) '總裝文件名稱
    
27. Path_ = TopDoc.GetPathName
    
28. TopDocName = Left(TopDocName, Len(TopDocName) - 7) '總裝文件名稱（排除.SLDASM）
    & u6 j: a* U- |" h% b
29. TopDocPathOnly = TopDocPathSplit(UBound(TopDocPathSplit) - 1) '總裝目錄名稱
    - h9 }6 Z* l, a6 D. y
30. TopConfString = TopDoc.GetActiveConfiguration.Name '總裝配置名稱
    
31. SubAsm TopDoc, TopConfString '遍歷
      K; G# E5 a, H1 j/ c
32. 
      k( \- |# H4 O% ?9 q6 ^& f5 }
33. End Sub
    3 O1 U, `, D% ?" c* W+ U
34. 
    ' [0 t4 n6 i1 r0 x6 f( T+ d) q
35. Function SubAsm(AsmDoc, ConfString)
    
36. Dim name_ay() As String
    % N- e  E) H- r) I* e) I; f
37. Set swModel = swApp.ActiveDoc
    
38. Set Configuration = AsmDoc.GetConfigurationByName(ConfString)
    
39. Set RootComponent = Configuration.GetRootComponent
    7 t4 }9 o9 B- S  u( R
40. Components = RootComponent.GetChildren
    6 q) j: G: d# ?6 m. O" B7 a+ K
41. For Each Child In Components '總裝抓全部零件名稱
    , |" |# ~! B. `' N6 T. w
42.     i = i + 1
    / X! z1 N0 I! k, ^6 _. l0 c3 S
43.     ReDim Preserve name_ay(i)
    
44.     Set ChildModel = Child.GetModelDoc
    
45.     ChildPathSplit = Split(Child.GetPathName, "") '分割
    
46.     ChildName = ChildPathSplit(UBound(ChildPathSplit)) '零件文件名稱
    9 Z  S, `( [  z) n+ t8 F- ~; K
47.     name_ay(i) = Left(ChildName, Len(ChildName) - 7) '編號_名稱
    
48.     swModel.DeleteCustomInfo2 "", name_ay(i)
    . M% N2 j9 D  G" b
49.     swModel.AddCustomInfo2 name_ay(i), swCustomInfoText, """SW-Material@" & name_ay(i) & ".SLDPRT"""
    1 @. k0 O5 N5 L0 S# k0 \  w8 w) {
50. Next
    ( D$ g( L4 |; ~
51. 
    
52. '~~~~~~~ parts_property ~~~~~~~
    
53. Dim longstatus As Long, longwarnings As Long
    
54. Dim retval As String
    2 o; @/ H6 X+ d: v  i
55. Set Part = swApp.ActiveDoc
    . ^5 q1 E$ n$ a- r+ ~" w7 {. y+ t
56. path_name = Part.GetPathName
    
57. TopDocPathSplit = Split(path_name, "") '分割
    
58. TopDocName = TopDocPathSplit(UBound(TopDocPathSplit))
    
59. Path_ = Left(path_name, Len(path_name) - Len(TopDocName))
    , I4 c( _6 D! K
60. For n = 1 To i
    
61.     Set Part = swApp.OpenDoc6(Path_ & name_ay(n) & ".SLDPRT", 1, 0, "", longstatus, longwarnings)
    * m  c0 a0 R" J
62.     swApp.ActivateDoc2 name_ay(n) & ".SLDPRT", False, longstatus
    ( b1 g, w! m' a
63.     Set swModel = swApp.ActiveDoc
    
64.     '~~~ 注意 L1 設定 ~~~
    * s4 z" ]  d7 D, K5 ?& c
65.     L1 = InStrRev(name_ay(n), "_", , 0) '編號_名稱是以 "_" 之符號分隔,可依需要更改所需之符號
    
66.     '~~~
    
67.     code_part = Left(name_ay(n), L1 - 1) ' 編號
    
68.     name_part = Right(name_ay(n), Len(name_ay(n)) - L1) '名稱
      A7 ?. n+ l7 @
69.     retval = swModel.DeleteCustomInfo("材質")
    " {8 M" ?" Y4 m' K; T9 f
70.     retval = swModel.AddCustomInfo3("", "材質", swCustomInfoText, """SW-Material@" & name_ay(n) & ".SLDPRT""")
    3 S  F. B% d: E0 ]) Q
71.     retval = swModel.DeleteCustomInfo("名稱")
    " j$ U/ H) N0 j! U
72.     retval = swModel.AddCustomInfo3("", "名稱", swCustomInfoText, name_part)
    
73.     retval = swModel.DeleteCustomInfo("編號")
    
74.     retval = swModel.AddCustomInfo3("", "編號", swCustomInfoText, code_part)
    5 F7 z% {8 J+ W- u: ~7 [/ h2 |
75.     swModel.Save
    / V7 S0 r$ k, M) v; y: z5 [8 P
76.     swApp.CloseDoc name_ay(n) & ".SLDPRT"
    
77. Next
    7 H  o) j2 [6 A# `7 S/ y0 {
78. End Function
    

复制代码

: S: L1 a6 {8 e8 r1 ~$ }1 J. T
Macro1.rar (7.28 KB, 下载次数: 60)

2017-8-11 21:42 上传

点击文件名下载附件   swp文件 (繁版)
6 ~5 G' G) ~8 t3 D, C
3 K' \+ @5 O. g2 K

NC@jiang@nan

三维网技术论坛复制代码真是麻烦。复制下来一大堆的乱码。就算用下面的“复制代码”功能复制下来的照样是一堆的乱码。

ryouss

NC@jiang@nan 发表于 2017-8-11 20:05
三维网技术论坛复制代码真是麻烦。复制下来一大堆的乱码。就算用下面的“复制代码”功能复制下来的照样是一 ...

9 _/ v3 O* E1 D* e+ V1 A' g" H4 S是喔!即時補上swp

NC@jiang@nan

ryouss 发表于 2017-8-11 20:30
) L3 Z- ~0 _( T7 y/ P& v是喔!即時補上swp

. _6 F6 G1 g. \' y! C谢谢梁大。
正在复制您的代码在对照修改，刷新发现您上传了SWP原文件，谢谢了。
( m4 Z* X6 Q: p. ?/ C7 N三维网复制代码这个功能真的需要完善完善了，好麻烦。

ryouss

NC@jiang@nan 发表于 2017-8-11 20:52
谢谢梁大。
正在复制您的代码在对照修改，刷新发现您上传了SWP原文件，谢谢了。
三维网复制代码这个功 ...

8 y2 a$ S0 c: J0 F- z: }順便幫忙試試word轉譯的簡版是否可用!謝謝

NC@jiang@nan

ryouss 发表于 2017-8-11 21:03
" A9 t. F8 I3 S! N. T: v$ h$ _& t順便幫忙試試word轉譯的簡版是否可用!謝謝

梁大，经测试，复制您的SWP中的内容至word后用简繁转换功能转换后没用。打开您的SWP后查看代码的文字部分是乱码，复制到word转换后还是乱码。

ryouss

NC@jiang@nan 发表于 2017-8-11 21:17
梁大，经测试，复制您的SWP中的内容至word后用简繁转换功能转换后没用。打开您的SWP后查看代码的文字部分 ...

謝謝測試!那只能用繁版自行重打字了

會再重傳swp.

NC@jiang@nan

ryouss 发表于 2017-8-11 21:38
$ ~0 p0 X, G2 L; a( k5 F謝謝測試!那只能用繁版自行重打字了

% M  v6 B( k7 m) w會再重傳swp.

梁大，您又重传了SWP吗？
我看上传时间是刚上传，下载下来打开还是乱码。
因为我之前的文件，零部件是 代号_名称 的形式存档的，但标准件不是以这种格式存档的，所以我打开装配体后测试时报错了，不知道是因为文件存档名称的格式的问题还是什么问题。但是在读取标准件前已经遍历过了的打开过了的零件已经分离图号和名称成功了。我需要删除所有标准件后再测试下。

NC@jiang@nan

ryouss 发表于 2017-8-11 21:38
謝謝測試!那只能用繁版自行重打字了
# i9 I/ J: \. l% Q5 R
會再重傳swp.

% r) ~0 _! U' D) F0 ]- ^梁大，我删除了所有标准件后测试，总装层下的的所有零件的图号和名称分离成功。
7 Q- g3 Q5 @5 X) Z7 {稍遗憾的是不能分离子装配体和子装配体下的零件的图号、名称。

Function SubAsm(AsmDoc, ConfString)

) }% c' J( X9 C0 a% y这些Function子程序代码我搞不清楚用法，想修改一下也没法下手。我还是需要多学习代码的知识了。

ryouss

# u9 @3 n2 l2 d5 G5 S

NC@jiang@nan 发表于 2017-8-11 22:18
梁大，我删除了所有标准件后测试，总装层下的的所有零件的图号和名称分离成功。
6 g5 ~4 ~# R% s* f稍遗憾的是不能分离子装 ...

, U0 m9 D4 K6 J9 f+ Y謝謝測試.
, x, I6 U; N: Q1 l" ?有關子装配体和子装配体下的零件的图号名称,尚再找資料學習中.
, o6 y& f' A( p1 B& u: r
/ e3 z  _; s+ X3 [8 K' u1 s" nN大手中若是有資料尚請提供分享.

NC@jiang@nan

ryouss 发表于 2017-8-11 22:29
( U% c! f" d' D/ W0 @& W謝謝測試.
有關子装配体和子装配体下的零件的图号名称,尚再找資料學習中.

) n$ H2 a" E( [) _: }: z# F! r梁大，我手是什么VBA的资料都没有，手上就只有一本VB的书，买了两年了，放在床头被狗啃坏了都没看。读书时还是DOS系统，这些编程语言都没学过，语法都搞不大清楚，现在只能寄希望于能从您和各位高人分享的精品宏文件中多学习以提高一点水平了。有问题时还请各位老大位多多指点了。

NC@jiang@nan

ryouss 发表于 2017-8-11 22:29
謝謝測試.
& F' c4 X' V3 }: E2 m! @有關子装配体和子装配体下的零件的图号名称,尚再找資料學習中.

梁大，我想起来了，之前好像闷大有分享过一个遍历装配体中零件数量把数量写入自定义属性的宏，从逻辑上分析的话，你的宏代码功能是否和闷大的差不多？是否可以两个宏结合下？
现在要我去新建一个宏文件基本上是不大现实的了，所以首先只能想想有没有类似功能的宏可以稍做修改来用。惭愧。

ryouss

NC@jiang@nan 发表于 2017-8-11 22:54
" `: U7 a' u! W0 t+ j6 y6 C梁大，我想起来了，之前好像闷大有分享过一个遍历装配体中零件数量把数量写入自定义属性的宏，从逻辑上分 ...

謝謝提供信息,查找了解了!

NC@jiang@nan

ryouss 发表于 2017-8-11 23:20
" z! I/ v' j+ i' k5 v謝謝提供信息,查找了解了!

闷大的宏的代码我这里有。我发TXT文件出来梁大你看看。

秋韵舞-江枫

感谢鹿大大及28大大！感谢各位的回复，感谢梁大大的回复及上传文件！您的宏我还没下载，但是有个问题，我现在的名称图号中间以空格区分，如果改成“-”号工作量非常大，不知能不能在我发的这个宏的基础上修改成可以遍历批处理的宏。

ryouss

3 S( c; W1 Y; U5 e( @) h

秋韵舞江机 发表于 2017-8-12 00:58
感谢鹿大大及28大大！感谢各位的回复，感谢梁大大的回复及上传文件！您的宏我还没下载，但是有个问题，我现 ...

) a; E" u# s+ Q5 u, gL1 = InStrRev(name_ay(n), "_", , 0) '編號_名稱是以 "_" 之符號分隔,可依需要更改所需之符號
% t! C; O, Y9 ?
5 c1 s/ g' \  q! Q, k0 u8 {1. 看上面,把黑色的  "_"  改成  "空格"  就是
3 e0 _5 x! M+ N" D, l) Y- X9 W2. 繁字自行改為簡字,綠色字可以不改.

秋韵舞-江枫

ryouss 发表于 2017-8-12 08:32
L1 = InStrRev(name_ay(n), "_", , 0) '編號_名稱是以 "_" 之符號分隔,可依需要更改所需之符號

1. 看 ...

/ n" t* u! y' J, ?7 x2 Q谢谢梁大细心指导！！