|
|
5#
楼主 |
发表于 2018-12-8 08:30:31
|
只看该作者
经典案例图书
试了下，说语句错误，可能我哪里弄错了，不过我找到一个我能用的了：
Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Dim PathStr As String
Dim FName(500) As String, FNum As Long
Sub main()
Dim i As Long
Dim PathStr0 As String, PathStr1 As String
Dim PathStr2 As String, PathStr3 As String, PathStr4 As String, PahtStr5 As String
Dim L As Long, L1 As Long
PathStr = InputBox("请输入需要转的工程图所在位置")
Call Showfilelist(PathStr)
Set swApp = Application.SldWorks
For i = 0 To FNum - 1
PathStr0 = PathStr & "\" & FName(i)
Set Part = swApp.OpenDoc6(PathStr0, 3, 0, "", longstatus, longwarnings)
L = Len(PathStr0)
PathStr1 = Left(PathStr0, L - 7) & ".DWG"
PathStr2 = Left(PathStr0, L - 7) & ".PDF"
longstatus = Part.SaveAs3(PathStr1, 0, 0)
longstatus = Part.SaveAs3(PathStr2, 0, 0)
Set Part = Nothing
L1 = Len(FName(i))
PathStr3 = Left(FName(i), L1 - 7) & " - 图纸1"
PathStr4 = Left(FName(i), L1 - 7) & " - 图纸2"
PathStr5 = Left(FName(i), L1 - 7) & " - 图纸3"
swApp.CloseDoc PathStr3
swApp.CloseDoc PathStr4
swApp.CloseDoc PathStr5
Next i
End Sub
Private Sub Showfilelist(folderspec As String)
Dim fs, f, f1, fc, s
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(folderspec)
Set fc = f.Files
FNum = 0 '清零
For Each f1 In fc
If InStr(f1.Name,"SLDDRW") > 0 Then
FName(FNum) = f1.Name
FNum = FNum + 1
End If
Next
End Sub
另外，附上我找到的图号分离宏：
Dim a As Integer
Dim b As String
Dim m As String
Dim e As String
Dim k As String
Dim t As String
Dim c As String
Dim j As Integer
Dim strmat As String
Dim tempvalue As String
Dim Part As Object
Dim swApp As SldWorks.SldWorks
Dim swModelDoc As SldWorks.ModelDoc2
Dim swConfig As SldWorks.Configuration
Dim CustPropMgr As SldWorks.CustomPropertyManager
Dim swModel As SldWorks.ModelDoc2
Sub main()
Set swApp = Application.SldWorks
Set swModelDoc = swApp.ActiveDoc
Set swConfig = swModelDoc.ConfigurationManager.ActiveConfiguration
Set swModel = swApp.ActiveDoc
Set CustPropMgr = swModel.Extension.CustomPropertyManager(swModel.ConfigurationManager.ActiveConfiguration.Name) '配置特定延伸
'设定变量
c = swApp.ActiveDoc.GetTitle() '零件名
strmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)
a = InStr(c, " ") - 1 '重点：分隔标识符，这里是一个空格，也可换成其他符号
If a > 0 Then
k = Left(c, a)
t = Left(LTrim(e), 3)
If t = "GBT" Then
e = "GB/T" + Mid(k, 4)
Else
e = k
End If
b = Mid(c, a + 2)
t = Right(c, 7)
If t = ".SLDPRT" Or t = ".SLDASM" Or t = ".sldprt" Or t = ".sldasm" Then
j = Len(b) - 7 '消除后缀（区分大小写，即含4种）
Else
j = Len(b)
End If
m = Left(b, j)
End If
'删除栏 CustPropMgr.Delete ("PartName")
CustPropMgr.Delete ("PartName")
CustPropMgr.Delete ("Number")
'新增
CustPropMgr.Add2 "Number", swCustomInfoText, e
CustPropMgr.Add2 "PartName", swCustomInfoText, m
CustPropMgr.Add2 "数量", swCustomInfoText, ""
CustPropMgr.Add2 "Material", swCustomInfoText, strmat
CustPropMgr.Add2 "Weight", swCustomInfoText, ""
CustPropMgr.Add2 "总重", swCustomInfoText, ""
CustPropMgr.Add2 "Description", swCustomInfoText, ""
End Sub |
|
[复制链接]
QQ好友和群
QQ空间
腾讯微博
腾讯朋友
收藏
转播
教程|习题|模型|技巧
点赞
拍砖
发表于 2018-12-7 16:08:12
鲁公网安备 37028502190335号