求高手制作一个批量运行FeatureWorks 特征识别（付费）

lgplyh · 发表于 2024-9-5 11:28:17

经典图书

费用可以聊，具体要求：
1.依次读取指定文件夹里的通用3D格式的文件，如.step或.xt格式
2.依次读取并打开文件，先运行输入诊断，修复错误和缝隙
3.再行FeatureWorks 进行特征识别
4.判断是否识别成功：
1）如果识别特征后模型树中间有输入特征，判断识别失败，则跳过下面第5步，不保存这个文件，关闭。
2）如果如果识别特征后模型树中间没有有输入特征，识别成功，则执行下面第5步，保存这个文件，关闭。
5.保存原文件名SW格式文件文件（原文件名.SLDPRT），关闭。
v:hatovip

yzzjy1 · 发表于 2024-9-5 22:06:47

顶一下，坐等高手！

沉默的人 · 发表于 2024-9-6 08:25:26

经典图书

顶一下，坐等高手！

随遇而安9528 · 发表于 2024-9-7 09:48:16

Option Explicit

' 主程序入口
Sub Main()
Dim folderPath As String
' 设置指定文件夹路径
folderPath = "your_folder_path"

' 获取指定文件夹下第一个扩展名为.step 的文件名
Dim file As String
file = Dir(folderPath & "\*.step")
' 循环处理每个.step 文件
Do While file <> ""
      ProcessFile (folderPath & "\" & file)
      ' 获取下一个扩展名为.step 的文件名
      file = Dir()
Loop

' 获取指定文件夹下第一个扩展名为.xt 的文件名
file = Dir(folderPath & "\*.xt")
' 循环处理每个.xt 文件
Do While file <> ""
      ProcessFile (folderPath & "\" & file)
      ' 获取下一个扩展名为.xt 的文件名
      file = Dir()
Loop
End Sub

' 处理单个文件的过程
Sub ProcessFile(filePath As String)
Dim swApp As SldWorks.SldWorks
' 创建 SolidWorks 应用程序对象
Set swApp = CreateObject("SldWorks.Application")

Dim swModel As SldWorks.ModelDoc2
' 打开指定文件
Set swModel = swApp.OpenDoc(filePath, 1)

' 运行输入诊断命令
swModel.Extension.RunCommand ("输入诊断")
' 运行 FeatureWorks 特征识别命令
swModel.Extension.RunCommand ("FeatureWorks")

Dim modelTree As SldWorks.FeatureManager
' 获取特征管理器
Set modelTree = swModel.FeatureManager

Dim hasInputFeature As Boolean
hasInputFeature = False
Dim feature As SldWorks.Feature
' 遍历模型树中的每个特征
For Each feature In modelTree.GetFeatures(True)
      ' 判断特征名称中是否包含"输入特征"
      If InStr(1, feature.Name, "输入特征", vbTextCompare) > 0 Then
         hasInputFeature = True
         Exit For
      End If
Next

If hasInputFeature Then
      ' 如果有输入特征，识别失败，关闭文件不保存
      swModel.CloseDoc False
Else
      ' 如果没有输入特征，识别成功，保存为 SW 格式文件并关闭
      Dim newFilePath As String
      newFilePath = Left(filePath, InStrRev(filePath, ".")) & "SLDPRT"
      swModel.SaveAs3 newFilePath, 0, 2
      swModel.CloseDoc True
End If
End Sub

随遇而安9528 · 发表于 2024-9-7 09:49:16

经典案例图书

<span style="color: rgb(28, 31, 35); font-family: Inter, -apple-system, BlinkMacSystemFont, "Segoe UI", "SF Pro SC", "SF Pro Display", "SF Pro Icons", "PingFang SC", "Hiragino Sans GB", "Microsoft YaHei", "Helvetica Neue", Helvetica, Arial, sans-serif; font-size: medium; white-space: pre; background-color: rgb(255, 255, 255);">Option Explicit
' 主程序入口
Sub Main()
Dim folderPath As String
' 设置指定文件夹路径
folderPath = "your_folder_path"
' 获取指定文件夹下第一个扩展名为.step 的文件名
Dim file As String
file = Dir(folderPath & "\*.step")
' 循环处理每个.step 文件
Do While file <> ""
ProcessFile (folderPath & "\" & file)
' 获取下一个扩展名为.step 的文件名
file = Dir()
Loop
' 获取指定文件夹下第一个扩展名为.xt 的文件名
file = Dir(folderPath & "\*.xt")
' 循环处理每个.xt 文件
Do While file <> ""
ProcessFile (folderPath & "\" & file)
' 获取下一个扩展名为.xt 的文件名
file = Dir()
Loop
End Sub
' 处理单个文件的过程
Sub ProcessFile(filePath As String)
Dim swApp As SldWorks.SldWorks
' 创建 SolidWorks 应用程序对象
Set swApp = CreateObject("SldWorks.Application")
Dim swModel As SldWorks.ModelDoc2
' 打开指定文件
Set swModel = swApp.OpenDoc(filePath, 1)
' 运行输入诊断命令
swModel.Extension.RunCommand ("输入诊断")
' 运行 FeatureWorks 特征识别命令
swModel.Extension.RunCommand ("FeatureWorks")
Dim modelTree As SldWorks.FeatureManager
' 获取特征管理器
Set modelTree = swModel.FeatureManager
Dim hasInputFeature As Boolean
hasInputFeature = False
Dim feature As SldWorks.Feature
' 遍历模型树中的每个特征
For Each feature In modelTree.GetFeatures(True)
' 判断特征名称中是否包含"输入特征"
If InStr(1, feature.Name, "输入特征", vbTextCompare) > 0 Then
hasInputFeature = True
Exit For
End If
Next
If hasInputFeature Then
' 如果有输入特征，识别失败，关闭文件不保存
swModel.CloseDoc False
Else
' 如果没有输入特征，识别成功，保存为 SW 格式文件并关闭
Dim newFilePath As String
newFilePath = Left(filePath, InStrRev(filePath, ".")) & "SLDPRT"
swModel.SaveAs3 newFilePath, 0, 2
swModel.CloseDoc True
End If
End Sub</span>

复制代码

董东咚 · 发表于 2024-9-9 08:33:37

活到老学到老！

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

求高手制作一个批量运行FeatureWorks 特征识别（付费）

最佳新人

活跃会员

热心会员

宣传达人

灌水之王

突出贡献