solidworks里面的宏操作
发布网友
发布时间：2022-05-04 22:07
共5个回答
热心网友
时间：2022-06-26 08:58
Dim Part As Object
Dim Filename As String
Dim No As Integer
Dim Title As String
Sub main()
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
Filename = Part.GetPathName()
No = Len(Filename)
Filename = Left(Filename, No)
Part.SaveAs2 Filename & ".DWG", 0, True, False
End Sub
这段代码是我用的，我保存工程图时按一下宏就自动存一份dwg格式的，再按就是自动替换，把宏Part.SaveAs2 Filename & ".DWG", 0, True, False这一段中的dwg换成其他格式也行，在下面加一行其他格式的也就自动存两个格式了。
热心网友
时间：2022-06-26 08:58
用这个工具可以批量转换，至于用宏录制，我试了几次，发现自己创建的宏老是出错，可能是生成的代码有问题，又不太懂编程语言，很是纠结
热心网友
时间：2022-06-26 08:59
Dim Part As Object
Dim Filename As String
Dim No As Integer
Dim Title As String
Dim swModel As ModelDoc2
Dim vCustInfoNameArr2 As Variant
Dim cpm As CustomPropertyManager
Dim a As Integer
Dim b As String
Dim name As String
Dim partnumber As String
Dim k As String
Dim t As String
Dim shortdate As String
Dim j As Integer
Dim Patch As String
Dim CustPropMgr As SldWorks.CustomPropertyManager
Dim vCustInfoNameArr3 As Variant
Sub main() '先删除自定义属性，在给自定义属性赋值
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set Part = swApp.ActiveDoc
Set cpm = swModel.Extension.CustomPropertyManager("")
vCustInfoNameArr2 = swModel.GetCustomInfoNames
If Not IsEmpty(vCustInfoNameArr2) Then
For Each vCustInfoName2 In vCustInfoNameArr2
bRet = swModel.DeleteCustomInfo(vCustInfoName2)
Next
End If
'（以上为删除自定义属性里所有内容）
Title = swApp.ActiveDoc.GetTitle() '提取零件名
j = Len(Title) - 6
Title = Left(Title, j)
Patch = swApp.ActiveDoc.GetPathName() '取得"路径名称及扩展名"(不管扩展名是否隐藏)
shortdate = Chr(36) + "PRP" + Chr(58) + Chr(34) + "SW-Short Date" + Chr(34) '设定当前短日期
a = InStr(Title, "-") - 1 '提取-字符个数
If a > 0 Then '判定a是否为空
k = Left(Title, a) 'K为文件名从左开始a个字符文字
partnumber = k
b = Mid(Title, a + 2) 'b的内容是从零件名的第A+2个字符开始截取（内容，第几个开始，截取长度）
t = Right(Title, 7) '从文件名右侧开始提取7个字符文字设为t
If t = ".SLDPRT" Or t = ".SLDASM" Then
j = Len(b) - 7 '如果t是SW零件或SW装配体则j的长度为b长度-7
Else
j = Len(b) '否则j的长度为b的长度
End If
name = Left(b, j)
Else
partnumber = ""
b = Mid(Title, a + 2) 'b的内容是从零件名的第A+2个字符开始截取（内容，第几个开始，截取长度）
t = Right(Title, 7) '从文件名右侧开始提取7个字符文字设为t
If t = ".SLDPRT" Or t = ".SLDASM" Then
j = Len(b) - 7 '如果t是SW零件或SW装配体则j的长度为b长度-7
Else
j = Len(b) '否则j的长度为b的长度
End If
name = Left(b, j)
End If
Patch = Left(Patch, InStrRev(Patch, "\", -1)) '提出路径
Dim G
Dim H
Dim Projectnumber As String
Dim Projectname As String
Dim q As String
Dim r As String
Dim u As String
Dim y As String
G = Split(Patch, "\") '将路径用\分割
H = UBound(G) - 1 '提取最后一段是第几段，则G(H)就是最后一段里的内容
q = InStr(G(H), "-") - 1
If q > 0 Then
Projectnumber = Left(G(H), q)
r = Mid(G(H), q + 2)
y = Len(r)
Projectname = Left(r, y)
End If
cpm.Add2 "Part Number", swCustomInfoText, partnumber
cpm.Add2 "Name", swCustomInfoText, name
cpm.Add2 "Material", swCustomInfoText, """SW-Material@" & Title & ".SLDPRT"""
cpm.Add2 "Weight", swCustomInfoText, """SW-Mass@" & Title & ".SLDPRT"""
cpm.Add2 "Revision", swCustomInfoText, " "
cpm.Add2 "Author", swCustomInfoText, ""
cpm.Add2 "Author Date", swCustomInfoText, shortdate
cpm.Add2 "Project number", swCustomInfoText, Projectnumber
cpm.Add2 "Project Name", swCustomInfoText, Projectname
cpm.Add2 "Description", swCustomInfoText, " "
'另存为IGS文件
Filename = Part.GetPathName()
No = Len(Filename)
Filename = Left(Filename, No - 7)
Part.SaveAs2 Filename & ".IGS", 0, True, False
Title = Part.GetTitle
Part.Save '保存
'swApp.CloseDoc Title
'X = MsgBox("输出pdf文件在SW工程图同一文件夹", 0)
End Sub
热心网友
时间：2022-06-26 08:59
热心网友
时间：2022-06-26 09:00
