SolidWorks机械工程师网——最大的SolidWorks学习平台

标题: 麻烦哪位大佬指证一下代码错误 [打印本页]
作者: ufong13    时间: 2024-9-24 23:59
标题: 麻烦哪位大佬指证一下代码错误
下面的宏代码用于在配置特定中自动生成项目号一栏，当文件名格式为E2401A000000000 零件，文件号的前6号代表了项目号，E为项目属性，24为年代号，代表2024年，01为项目序号，代表24年第一个项目号，A代表设备数量，A表示此项目只有一台设备，如果是B就表示此项目有两台设备，当项目只有一台设备时项目号格式就是E2024-01-1，最后的-1省略不做，项目号即为E2024-01。当项目有两台的设备时，文件名为E2401B000000000 零件,项目号就需要在最后加写上与B对应的-2，即项目号为E2024-01-2。


宏运行时提示用户定义类型未定义


  1. Sub SetProjectNumberFromFileName()  
  2.     Dim swApp As SldWorks.SldWorks  
  3.     Dim Part As SldWorks.ModelDoc2  
  4.     Dim custPropMgr As SldWorks.CustomPropertyManager  
  5.     Dim fileName As String  
  6.     Dim filePath As String  
  7.     Dim projectCode As String  
  8.     Dim projectYear As String  
  9.     Dim projectNumber As String  
  10.     Dim deviceCount As String  
  11.     Dim finalProjectNumber As String  
  12.       
  13.     ' 获取SolidWorks应用程序对象  
  14.     Set swApp = Application.SldWorks  
  15.       
  16.     ' 检查是否有活动文档  
  17.     If swApp.ActiveDoc Is Nothing Then  
  18.         MsgBox "没有打开的文档", vbExclamation  
  19.         Exit Sub  
  20.     End If  
  21.       
  22.     ' 获取活动文档  
  23.     Set Part = swApp.ActiveDoc  
  24.       
  25.     ' 确保是零件文档  
  26.     If Not TypeOf Part Is SldWorks.ModelDoc2 Then  
  27.         MsgBox "当前文档不是零件文档", vbExclamation  
  28.         Exit Sub  
  29.     End If  
  30.       
  31.     ' 获取文件名和路径  
  32.     filePath = Part.GetPathName  
  33.     fileName = Dir(filePath)  
  34.       
  35.     ' 提取项目号信息  
  36.     ' 假设文件名格式为 "E2401A000000000 零件.sldprt" 或 "E2401B000000000 零件.sldprt"  
  37.     projectCode = Left(fileName, 7) ' 提取前7个字符  
  38.     projectYear = Mid(projectCode, 2, 2) ' 提取年份后两位  
  39.     projectYear = "20" & projectYear ' 转换为完整的年份格式  
  40.     projectNumber = Mid(projectCode, 4, 2) ' 提取项目序号  
  41.     deviceCount = Mid(projectCode, 7, 1) ' 提取设备数量标识  
  42.       
  43.     ' 根据设备数量格式化最终的项目号  
  44.     If deviceCount = "A" Then  
  45.         finalProjectNumber = "E" & projectYear & "-" & projectNumber  
  46.     ElseIf deviceCount = "B" Then  
  47.         finalProjectNumber = "E" & projectYear & "-" & projectNumber & "-2"  
  48.     Else  
  49.         MsgBox "无法识别的设备数量标识：" & deviceCount, vbExclamation  
  50.         Exit Sub  
  51.     End If  
  52.       
  53.     ' 获取特定配置的自定义属性管理器  
  54.     ' 注意：这里假设我们操作的是默认配置，如果要针对特定配置，需要额外处理  
  55.     Set custPropMgr = Part.Extension.CustomPropertyManager("") ' 空字符串表示默认配置  
  56.       
  57.     ' 尝试设置或更新项目号自定义属性  
  58.     Dim errCode As Long  
  59.     errCode = custPropMgr.Add2("项目号", finalProjectNumber, swCustomInfo_ConfigurationSpecific, swCustPropertyTypeText, "")  
  60.       
  61.     ' 如果属性已存在，则更新它  
  62.     If errCode = swCustomPropertyInfo_AlreadyExists Then  
  63.         errCode = custPropMgr.Edit2("项目号", finalProjectNumber, swCustomInfo_ConfigurationSpecific, swCustPropertyTypeText)  
  64.     End If  
  65.       
  66.     ' 检查是否有错误  
  67.     If errCode <> 0 And errCode <> swCustomPropertyInfo_AlreadyExists Then  
  68.         MsgBox "设置自定义属性时出错：" & errCode, vbExclamation  
  69.     Else  
  70.         MsgBox "项目号已成功设置为：" & finalProjectNumber, vbInformation  
  71.     End If  
  72.       
  73.     ' 清理  
  74.     Set custPropMgr = Nothing  
  75.     Set Part = Nothing  
  76.     Set swApp = Nothing  
  77. End Sub
复制代码


作者: 沉默的人    时间: 2024-9-25 13:29
顶一下，坐等高手！
作者: wjbg2019    时间: 2024-9-25 13:54
那一句报错？
作者: ufong13    时间: 2024-9-25 20:54
已经解决了，我把图号分离的代码与上面项目号的代码合在一起了，现在可能实现项目号、图号、名称根据文件名进行自动填写，下一步准备解决根据文件名自动识别填写材料号、焊接件、组件及部件
  1. Dim a As Integer

  3. Dim b As String

  5. Dim m As String

  7. Dim e As String

  9. Dim k As String

  11. Dim t As String

  13. Dim c As String

  15. Dim j As Integer

  17. Dim strmat As String

  19. Dim tempvalue As String

  21. Dim Part As SldWorks.ModelDoc2

  23. Dim swApp As SldWorks.SldWorks

  25. Dim swModelDoc As SldWorks.ModelDoc2

  27. Dim swConfig As SldWorks.Configuration

  29. Dim CustPropMgr As SldWorks.CustomPropertyManager

  31. Dim swModel As SldWorks.ModelDoc2
  32.     Dim projectCode As String
  33.     Dim projectYear As String
  34.     Dim projectNumber As String
  35.     Dim deviceCount As String
  36.     Dim finalProjectNumber As String
  37.     Dim fileName As String
  38.     Dim filePath As String

  40. Sub main()

  42. Set swApp = Application.SldWorks

  44. Set swModelDoc = swApp.ActiveDoc

  46. Set swConfig = swModelDoc.ConfigurationManager.ActiveConfiguration

  48. Set swModel = swApp.ActiveDoc

  50. Set CustPropMgr = swModel.Extension.CustomPropertyManager(swModel.ConfigurationManager.ActiveConfiguration.Name)

  52. '设定变量

  54. c = swApp.ActiveDoc.GetTitle() '零件名

  56. strmat = Chr(34) + Trim("SW-Material" + "@") + c + Chr(34)

  58. a = InStr(c, " ") - 1 '重点：分隔标识符，这里是一个空格，也可换成其他符号

  60. If a > 0 Then

  62. k = Left(c, a)

  64. t = Left(LTrim(e), 3)

  66. If t = "GBT" Then

  68. e = "GB/T" + Mid(k, 4)

  70. Else

  72. e = k

  74. End If

  76. b = Mid(c, a + 2)

  78. t = Right(c, 7)

  80. If t = ".SLDPRT" Or t = ".SLDASM" Or t = ".sldprt" Or t = ".sldasm" Then

  82. j = Len(b) - 7

  84. Else

  86. j = Len(b)

  88. End If

  90. m = Left(b, j)

  92. End If

  94.    
  95. ' 获取SolidWorks应用程序对象
  96.     Set swApp = Application.SldWorks
  97.       
  98.     ' 检查是否有活动文档
  99.     If swApp.ActiveDoc Is Nothing Then
  100.         MsgBox "没有打开的文档", vbExclamation
  101.         Exit Sub
  102.     End If
  103.       
  104.     ' 获取活动文档
  105.     Set Part = swApp.ActiveDoc
  106.       
  107.     ' 确保是零件文档
  108.     If Not TypeOf Part Is SldWorks.ModelDoc2 Then
  109.         MsgBox "当前文档不是零件文档", vbExclamation
  110.         Exit Sub
  111.     End If
  112.    
  113. ' 获取文件名和路径
  114.     filePath = Part.GetPathName
  115.     fileName = Dir(filePath)

  117. ' 提取项目编号信息
  118.     ' 假设文件名格式为 "E2401A000000000 零件.sldprt" 或 "E2401B000000000 零件.sldprt"
  119.     projectCode = Left(fileName, 7) ' 提取前7个字符
  120.     projectYear = Mid(projectCode, 2, 2) ' 提取年份后两位
  121.     projectYear = "20" & projectYear ' 转换为完整的年份格式
  122.     projectNumber = Mid(projectCode, 4, 2) ' 提取项目序号
  123.     deviceCount = Mid(projectCode, 6, 1) ' 提取设备数量标识
  124.    
  125. ' 根据设备数量格式化最终的项目编号
  126.     If deviceCount = "A" Then
  127.         finalProjectNumber = "E" & projectYear & "-" & projectNumber
  128.     ElseIf deviceCount = "B" Then
  129.         finalProjectNumber = "E" & projectYear & "-" & projectNumber & "-2"
  130.     ElseIf deviceCount = "C" Then
  131.         finalProjectNumber = "E" & projectYear & "-" & projectNumber & "-3"
  132.     ElseIf deviceCount = "D" Then
  133.         finalProjectNumber = "E" & projectYear & "-" & projectNumber & "-4"
  134.     ElseIf deviceCount = "E" Then
  135.         finalProjectNumber = "E" & projectYear & "-" & projectNumber & "-5"
  136.     ElseIf deviceCount = "F" Then
  137.         finalProjectNumber = "E" & projectYear & "-" & projectNumber & "-6"
  138.     ElseIf deviceCount = "G" Then
  139.         finalProjectNumber = "E" & projectYear & "-" & projectNumber & "-7"
  140.     ElseIf deviceCount = "H" Then
  141.         finalProjectNumber = "E" & projectYear & "-" & projectNumber & "-8"
  142.     ElseIf deviceCount = "I" Then
  143.         finalProjectNumber = "E" & projectYear & "-" & projectNumber & "-9"
  144.     Else
  145.         MsgBox "无法识别的设备数量标识：" & deviceCount, vbExclamation
  146.         Exit Sub
  147.     End If
  148. '删除原有
  149. CustPropMgr.Delete ("项目编号")

  151. CustPropMgr.Delete ("代号")

  153. CustPropMgr.Delete ("名称")

  155. '新增

  157. CustPropMgr.Add2 "项目编号", swCustomInfoText, finalProjectNumber

  159. CustPropMgr.Add2 "代号", swCustomInfoText, e

  161. CustPropMgr.Add2 "名称", swCustomInfoText, m



  165. End Sub
复制代码
作者: tantingshuai123    时间: 2024-9-26 22:20
好东西，努力学习学习！



欢迎光临 SolidWorks机械工程师网——最大的SolidWorks学习平台 (https://www.swbbsc.com/) Powered by Discuz! X3.2