Zemax光学设计从入门到精通	光学设计仿真实验指导	Zemax光学设计实践基础(陈家璧)	京东年货节，领红包！更优惠！
讯技光电:VirtualLab Fusion独家供应商	现代光学设计及应用(Zemax)	CODE V,LightTools,RSoft,LucidShape	计算光学带来的成像革命(第2季)

发帖回复

4393阅读
2回复

[求助]求大大修改一个sw在一个文件夹中批量导入txt并生成xyz曲线的宏 [复制链接]

上一主题下一主题

离线mainsquall

技术员

发帖: 324

光币: 39

光券: 0

只看楼主正序阅读楼主发表于: 2015-10-31

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