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

netbug1980 · 发表于 2017-12-30 05:40:33

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

名称图号分离.rar (8.42 KB, 下载次数: 171)

zhangrunze · 发表于 2018-8-15 17:24:58

遍历宏，第一次见到~
学习中~

edcrfv · 发表于 2017-12-30 06:51:28

有個簡單的宏,在裝配体執行效果如图是否適用?

ywlily · 发表于 2017-12-30 06:55:51

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

chenhaiyin · 发表于 2017-12-30 09:28:31

经典案例图书

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

liu8818 · 发表于 2017-12-30 15:51:07

N大可能误会我的意思了，可以修改装配体的名称图号，我的意思是在装配体的模式下，运行此宏，连装配体本身及子装配和零件一起修改！

cqbbpdy · 发表于 2017-12-30 18:07:24

经典案例图书

楼主的想法是把图号分离宏嵌套进遍历宏中去
执行遍历宏之后会遍历装配体中的每一个子装配每一个零件
这个可能要你自己研究研究 VBA相关的东西了

zsy2006 · 发表于 2017-12-30 18:34:00

俺只会笨方法，仅供参考。
1.利用网络上大大分享的批量修改属性工具，打开所有需要修改的零件及组件档案；
2.利用Excel数据》分列工具，将档案名称进行分列处理；

3.批量写入需要导入的属性（如图号&名称）

ps; 免责申明：非原创，俺从别处学回来的。

06060606 · 发表于 2017-12-30 19:00:36

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

stillwaters · 发表于 2017-12-31 00:23:04

參考眾大師的結晶,稍加整理一下,因沒經大批量及大容量的組件測試過,
所以建議僅在小批量及小容量的組件試試看了!
執行效果如附图.

' ******************************************************************************
' macro recorded on 08/11/17 by lsc
'
' 組合件及零件自訂屬性名稱.
'
' 本例之編號名稱是以 "_" 之符號分隔.
'
' 1. 把組件及零件置放在 "同文件路徑" 下
'
' 2. 開組件,執行 main [url=https://www.swbbsc.com/forum-57-1.html]宏[/url]
'
' ******************************************************************************
Dim TopDocPathOnly As String
Dim swModel As SldWorks.ModelDoc2
Dim swApp As SldWorks.SldWorks
Dim longstatus As Long, longwarnings As Long
Sub main()
Set swApp = Application.SldWorks
Set TopDoc = swApp.ActiveDoc '總裝對象
If TopDoc.GetType <> 2 Then
MsgBox ("Open Assembly")
Exit Sub '不是裝配=退出
End If
TopDocPathSplit = Split(TopDoc.GetPathName, "") '分割
TopDocName = TopDocPathSplit(UBound(TopDocPathSplit)) '總裝文件名稱
Path_ = TopDoc.GetPathName
TopDocName = Left(TopDocName, Len(TopDocName) - 7) '總裝文件名稱（排除.SLDASM）
TopDocPathOnly = TopDocPathSplit(UBound(TopDocPathSplit) - 1) '總裝目錄名稱
TopConfString = TopDoc.GetActiveConfiguration.Name '總裝[url=https://www.swbbsc.com/forum-53-1.html]配置[/url]名稱
SubAsm TopDoc, TopConfString '遍歷
End Sub
Function SubAsm(AsmDoc, ConfString)
Dim name_ay() As String
Set swModel = swApp.ActiveDoc
Set Configuration = AsmDoc.GetConfigurationByName(ConfString)
Set RootComponent = Configuration.GetRootComponent
Components = RootComponent.GetChildren
For Each Child In Components '總裝抓全部零件名稱
i = i + 1
ReDim Preserve name_ay(i)
Set ChildModel = Child.GetModelDoc
ChildPathSplit = Split(Child.GetPathName, "") '分割
ChildName = ChildPathSplit(UBound(ChildPathSplit)) '零件文件名稱
name_ay(i) = Left(ChildName, Len(ChildName) - 7) '編號_名稱
swModel.DeleteCustomInfo2 "", name_ay(i)
swModel.AddCustomInfo2 name_ay(i), swCustomInfoText, """SW-Material@" & name_ay(i) & ".SLDPRT"""
Next
'~~~~~~~ parts_property ~~~~~~~
Dim longstatus As Long, longwarnings As Long
Dim retval As String
Set Part = swApp.ActiveDoc
path_name = Part.GetPathName
TopDocPathSplit = Split(path_name, "") '分割
TopDocName = TopDocPathSplit(UBound(TopDocPathSplit))
Path_ = Left(path_name, Len(path_name) - Len(TopDocName))
For n = 1 To i
Set Part = swApp.OpenDoc6(Path_ & name_ay(n) & ".SLDPRT", 1, 0, "", longstatus, longwarnings)
swApp.ActivateDoc2 name_ay(n) & ".SLDPRT", False, longstatus
Set swModel = swApp.ActiveDoc
'~~~ 注意 L1 設定 ~~~
L1 = InStrRev(name_ay(n), "_", , 0) '編號_名稱是以 "_" 之符號分隔,可依需要更改所需之符號
'~~~
code_part = Left(name_ay(n), L1 - 1) ' 編號
name_part = Right(name_ay(n), Len(name_ay(n)) - L1) '名稱
retval = swModel.DeleteCustomInfo("材質")
retval = swModel.AddCustomInfo3("", "材質", swCustomInfoText, """SW-Material@" & name_ay(n) & ".SLDPRT""")
retval = swModel.DeleteCustomInfo("名稱")
retval = swModel.AddCustomInfo3("", "名稱", swCustomInfoText, name_part)
retval = swModel.DeleteCustomInfo("編號")
retval = swModel.AddCustomInfo3("", "編號", swCustomInfoText, code_part)
swModel.Save
swApp.CloseDoc name_ay(n) & ".SLDPRT"
Next
End Function

复制代码

Macro1.rar (7.28 KB, 下载次数: 154, 售价: 10 金币) swp文件 (繁版)

lanrongye · 发表于 2017-12-31 03:52:36

是喔!即時補上swp

kevin_cheng · 发表于 2017-12-31 04:36:19

谢谢工程师。
正在复制您的代码在对照修改，刷新发现您上传了SWP原文件，谢谢了。

lxh6188819 · 发表于 2017-12-31 16:13:23

順便幫忙試試word轉譯的簡版是否可用!謝謝

you1860 · 发表于 2018-1-1 04:34:10

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

hj35915 · 发表于 2018-1-1 04:38:32

加入QQ群
参与讨论和学习

或扫描二维码加入

謝謝測試!那只能用繁版自行重打字了
會再重傳swp.

mzb81728 · 发表于 2018-1-1 17:05:31

经典案例图书

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

419154121 · 发表于 2018-1-1 21:50:06

加入QQ群
参与讨论和学习

或扫描二维码加入

工程师，我删除了所有标准件后测试，总装层下的的所有零件的图号和名称分离成功。
稍遗憾的是不能分离子装配体和子装配体下的零件的图号、名称。
Function SubAsm(AsmDoc, ConfString)
这些Function子程序代码我搞不清楚用法，想修改一下也没法下手。我还是需要多学习代码的知识了。

cheng63533 · 发表于 2018-1-1 22:08:19

经典案例图书

謝謝測試.
有關子装配体和子装配体下的零件的图号名称,尚再找資料學習中.
N大手中若是有資料尚請提供分享.

airlqc · 发表于 2018-1-2 04:19:59

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

superpili · 发表于 2018-1-2 07:25:49

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

ellen_gl · 发表于 2018-1-2 13:49:09

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

		自动登录	找回密码
密码			立即注册

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

最佳新人

宣传达人