Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swModel As ModelDoc2
Dim cpm As CustomPropertyManager
Sub main()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set cpm = swModel.Extension.CustomPropertyManager("")
Dim path As String, filename As String, partno As String, partname As String, beizhu As String
path = swModel.GetPathName '获得文件路径和文件名称
filename = Mid$(path, InStrRev(path, "\") + 1) ' 获得文件名称及扩展名
filename = Left$(filename, InStrRev(filename, ".") - 1) '移除扩展名
partno = Left(filename, 10) ' 定义partno等于文件名的前9位
partname = Right(filename, Len(filename) - 10) ' 定义partname等于文件名剩下若干位
cpm.Delete "编码" ' 删除自定义属性“编码”
cpm.Delete "名称" ' 删除自定义属性“名称”
cpm.Delete "路径" ' 删除自定义属性“路径”
cpm.Add2 "编码", swCustomInfoText, partno ' 增加自定义属性“编码”
cpm.Add2 "名称", swCustomInfoText, partname ' 增加自定义属性“名称”
'cpm.Add2 "路径", swCustomInfoText, path '增加自定义属性“路径”
swModel.Save ' 保存文件
'swApp.CloseDoc (filename) ' 关闭当前激活文件
End Sub
————————————————————————————————————————————————————
以上是一种 SW工程图的编辑程序 添加在编辑宏内 ,在做工程图时 可以自动生成 零件名称 、图号、 材料类型、数量等。希望对大家有用!!
本站仅提供存储服务,所有内容均由用户发布,如发现有害或侵权内容,请
点击举报。