首页 -> 登录 -> 注册 -> 回复主题 -> 发表主题

光行天下 -> Pro/ENGINEER,Solidworks -> 求大大修改一个sw在一个文件夹中批量导入txt并生成xyz曲线的宏 [点此返回论坛查看本帖完整版本]

[打印本页]

mainsquall

2015-10-31 16:14

求大大修改一个sw在一个文件夹中批量导入txt并生成xyz曲线的宏

sw菜鸟一枚，看到论坛上有人发了一个同一个文件夹中批量导入txt画曲线的宏
现在需要把这个宏稍微改动下，在sw中一个文件夹中批量导入txt并生成xyz曲线，请大侠们出手改动下原帖中的宏。

宏贴出来如下：

Sub main()
Dim swApp                       As SldWorks.SldWorks
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
Dim myModelView As Object
If Part Is Nothing Then
MsgBox "请先打开或者新建SolidWorks Part"
Exit Sub
End If
Set myModelView = Part.ActiveView
myModelView.FrameState = swWindowState_e.swWindowMaximized

Dim sFileName As String
Dim fileConfig                  As String
Dim fileDispName                As String
Dim fileOptions                 As Long
Dim swSketchMgr                 As SldWorks.SketchManager
Dim swModel                     As SldWorks.ModelDoc2
Dim swSketchPt()                As SldWorks.SketchPoint

sFileName = swApp.GetOpenFileName("", "", "文本文件(*.txt) | *.txt", fileOptions, fileConfig, fileDispName)

If sFileName = "" Then
    MsgBox "没有选择txt数据文件", , "运行宏"
    Exit Sub
End If

Dim x, y, z As Double
Dim s
Dim n As Integer
Open sFileName For Input As #1
n = 0
Do While Not EOF(1)
         Line Input #1, s
         n = n + 1
Loop
Close #1
If n > 1024 Then
    MsgBox "点数量太大,超过1000,请分开后再导入", , "运行宏"
    Exit Sub
End If
ReDim swSketchPt(n)
Open sFileName For Input As #1
Set swSketchMgr = Part.SketchManager
    swSketchMgr.Insert3DSketch True
    swSketchMgr.AddToDB = True
    n = 0
    Do While Not EOF(1)
         Input #1, x
         If EOF(1) Then
         Exit Sub
         End If
         Input #1, y
         If EOF(1) Then
         Exit Sub
         End If
         Input #1, z
         n = n + 1
         Set swSketchPt(n) = swSketchMgr.CreatePoint(x / 1000, y / 1000, z / 1000)
    Loop
Close #1
End Sub

mainsquall	2015-11-07 13:47
有木有大神出来冒个泡~~

aliez11	2025-07-17 15:33
你好，解决了吗 }lq$Fi/

查看本帖完整版本: [-- 求大大修改一个sw在一个文件夹中批量导入txt并生成xyz曲线的宏 --] [-- top --]