导入同一文件夹下多个txt文件的宏问题

bj-alex · 发表于 2014-3-10 16:12:35

马上注册，结识高手，享用更多资源，轻松玩转三维网社区。

您需要登录才可以下载或查看，没有帐号？注册

x

本帖最后由 bj-alex 于 2014-3-10 22:12 编辑

我有大量的曲线坐标以文本方式保存，每条曲线一个文本文件，现需要将曲线导入。参考坛子里各位大神的方法，写了个自动输入的宏。调试也没发现错误，但是就是曲线显示不了？还望各位高手指点。
Sub main()
Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long

Set swApp =  Application.SldWorks

Set Part = swApp.ActiveDoc

Dim f As String, folder As String
folder = "E:\F\CU\Feb2014\5mm\01\"
f = Dir(folder & "*.txt")
While f > ""
Dim x, y, z As Double
Dim n As Integer
Part.InsertCurveFileBegin
Open folder & f For Input As #1
   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
      Part.InsertCurveFilePoint x, y, z
   Loop
Part.InsertCurveFileEnd
Close #1
f = Dir
Wend
End Sub

bj-alex · 发表于 2014-3-10 22:10:24

还请高手指点啊，这个问题困扰我好久了

ryouss · 发表于 2014-3-11 09:37:28

bj-alex 发表于 2014-3-10 22:10 static/image/common/back.gif
0 U G( T( V k8 ~. i! O$ H' D还请高手指点啊，这个问题困扰我好久了

1. TXT檔用連續不跳號之數字取名稱如 1.txt,2.txt ....,就可以配合 For Next 之 i 值,抓取全部的 TXT 檔.
2. 把全部的 TXT 檔置放在須要的文件路徑下.
3. 先開SW的零件檔,執行如下宏,會在零件檔新插入3D草圖作出全部的 TXT 放樣曲線圖.
4. 附檔是兩個測試檔 1.txt,2.txt 可以試看.

測試圖

Sub main()
Dim swApp As Object
Dim Part As Object
Dim boolstatus As Boolean
Dim longstatus As Long, longwarnings As Long
Dim SketchMgr                As Object
Dim pointArray As Variant
Dim points() As Double
On Error Resume Next
Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc
For i = 1 To 2
Dim f As String, folder As String
folder = "E:\F\CU\Feb2014\5mm\01\"
f = Dir(folder & i & "*.txt")
While f > ""
Dim x, y, z As Double
Dim s
Dim n As Integer
Open folder & f For Input As #1
n = 0
Do While Not EOF(1)
      Line Input #1, s
      n = n + 1
Loop
Close #1
Open folder & f For Input As #1
Set SketchMgr = Part.SketchManager
SketchMgr.Insert3DSketch True
ReDim points(1 To n * 3) As Double
n = 0
Do While Not EOF(1)
      Input #1, x
      points(n + 1) = x / 1000
      If EOF(1) Then
      Exit Sub
      End If
      Input #1, y
      points(n + 2) = y / 1000
      If EOF(1) Then
      Exit Sub
      End If
      Input #1, z
      points(n + 3) = z / 1000
      n = n + 3
Loop
Close #1
f = Dir
Wend
pointArray = points
Set skSegment = Part.SketchManager.CreateSpline((pointArray))
boolstatus = Part.EditRebuild3()
Next
End Sub

macro_txt.zip (17.57 KB, 下载次数: 33)

bj-alex · 发表于 2014-3-11 09:57:07

非常感谢！！如果txt文件太多，比如1000个，会不会造成死机？而且每个文件大小不同，在输入大文件时，所需的时间会久一点，所以，在每次循环之间需要延时函数不？

ryouss · 发表于 2014-3-11 10:02:05

本帖最后由 ryouss 于 2014-3-11 10:06 编辑

沒試不知道
試看再說了,有問題再讨论.
若有跳號要繼續執行就在
While f > "" 之上,插入 If f = "" Then GoTo aa
boolstatus = Part.EditRebuild3() 之上,插入 aa:

bj-alex · 发表于 2014-3-11 10:35:03

http://C:\\Users\\Alex Wang\\Desktop\\01
程序执行之后，显示的有草图，有3D草图，检查数据也没问题。

bj-alex · 发表于 2014-3-11 10:36:34

贴图失败

ryouss · 发表于 2014-3-11 10:43:23

本帖最后由 ryouss 于 2014-3-11 10:47 编辑

bj-alex 发表于 2014-3-11 10:35 static/image/common/back.gif* a, o* J" i, F! S8 k* F
程序执行之后，显示的有草图，有3D草图，检查数据也没问题。

显示的有草图,是前3d草圖作完沒跳出3d草圖的編輯狀態,就繼續作第2個文件.
正常是作完3d草圖用 boolstatus = Part.EditRebuild3() 重新計算跳出3d草圖的編輯狀態.
是用3#附檔文件測試的嗎

bj-alex · 发表于 2014-3-11 10:50:50

是用3#附件测试的。这么说，还是两次循环之间时间间隔太短。我可以把比一般文件大的多的挑出来，再试试。或者，加个延时。

ryouss · 发表于 2014-3-11 10:59:31

本帖最后由 ryouss 于 2014-3-11 11:00 编辑

bj-alex 发表于 2014-3-11 10:50 static/image/common/back.gif
Q/ H1 R( C* ?0 X& U; ~. y- g" p是用3#附件测试的。这么说，还是两次循环之间时间间隔太短。我可以把比一般文件大的多的挑出来，再试试。或 ...

3#附件,我測試是正常
在 boolstatus = Part.EditRebuild3() 之下, 補上如下作緩沖看看
Dim myModelView As Object
Set myModelView = Part.ActiveView
myModelView.RotateAboutCenter 0, 0

bj-alex · 发表于 2014-3-11 11:07:53

还是不行，我用附件中的数据测试的。您试试？我一次之选了10个文件。

bj-alex · 发表于 2014-3-11 11:40:09

感觉是循环语句的问题。f=Dir之后，i值并没有变化啊。

ryouss · 发表于 2014-3-11 11:44:04

bj-alex 发表于 2014-3-11 11:07 static/image/common/back.gif, p/ [; i* D% w P. g. Q
还是不行，我用附件中的数据测试的。您试试？我一次之选了10个文件。

如下有誤
f = Dir(folder & i & "*.txt")
把 *.txt 改為 .txt (拿掉 * )
另來檔沒 5.txt

測試正常

bj-alex · 发表于 2014-3-11 11:50:23

我故意把5拿掉的，是想测试下i值不连续的情况。

ryouss · 发表于 2014-3-11 11:56:49

bj-alex 发表于 2014-3-11 11:50 static/image/common/back.gif$ t( |& c$ I: a( W2 f
我故意把5拿掉的，是想测试下i值不连续的情况。

有跳號處理就參考5#的解決方法

bj-alex · 发表于 2014-3-11 12:02:48

程序运行正常！非常感谢ryouss的无私帮助！
我在想，如果写个宏，一次只输入一条曲线。然后再用另一宏循环调用它，这样也许可以解决文件数太多时，容易死机的情况。下午有空试试。
另外，再试试使用InsertCurveFile函数。
再次感谢ryouss!!

ryouss · 发表于 2014-3-11 14:30:38

1~500 約跑12分鐘

bj-alex · 发表于 2014-3-15 10:20:56

本帖最后由 bj-alex 于 2014-3-15 17:32 编辑

ryouss 发表于 2014-3-11 14:30 static/image/common/back.gif
; y6 d' O. E2 X( Q1 f1~500 約跑12分鐘

我现在已经将数据都导入了，形成了曲线，非常感谢您的指导。
另一个问题来了，这只是一层的数据，我还有很多层同样的数据。现在需要在对应位置的曲线，在垂直方向上连接成曲面，就是形成一个垂直的圆柱面。我用放样曲面，再选中两层的两个曲线，形成不了曲面啊。

bj-alex · 发表于 2014-3-15 10:26:56

现附上第二层，和第三层的数据。我做了好几天了，还是形不成曲面。还望指点。

bj-alex · 发表于 2014-3-15 17:17:34

在原来程序之上修改，用insertcurvefile函数导入800个txt文档，只需要3分钟。但是，无法编辑曲线。
用3D草图导入txt文档，虽然耗时，但是可以编辑曲线。
另：3D草图导入的曲线，无法使用放样曲面。

ryouss · 发表于 2014-3-15 20:40:45

本帖最后由 ryouss 于 2014-3-15 20:42 编辑

bj-alex 发表于 2014-3-15 17:17 static/image/common/back.gif
. O0 U( e( X& M3 e j1 N在原来程序之上修改，用insertcurvefile函数导入800个txt文档，只需要3分钟。但是，无法编辑曲线。
" K v+ N& b$ ^( [3 q( L: Z用3D草 ...

生成的草圖是能夠做放樣曲面,
應該是第一層和第二層的點沒對應吧

3D草圖5是你提供的第6檔,3D草圖10是依據第6檔做對應點的放樣曲線,因點有對應就可以做出放樣拉伸曲面.

bj-alex · 发表于 2014-3-18 14:44:45

ryouss 发表于 2014-3-15 20:40 static/image/common/back.gif
* K- Q2 O6 m& {' O$ i% G5 `' S e& b生成的草圖是能夠做放樣曲面,
1 E) x! {( M; H. `應該是第一層和第二層的點沒對應吧

如果是两个同心圆呢？只是一个大，一个小，却没有一个对应点，这样也做不了放样曲面？
除了这种办法，还有没有其他方法，生成曲面？

冲浪高手online · 发表于 2019-10-20 19:21:57

两位好强，解决了我遇到的问题

zbq2334 · 发表于 2020-7-8 22:47:10

两位高手非常强，我非常佩服，在你们宏文件的指导下，我依葫芦画瓢做了“宏”，批量做出了31条沿齿高方向的齿面曲线(31条曲线曲面放样是面齿轮的齿面，齿高方向就是沿坐标的Z轴方向。31条曲线的坐标点是在Excel里用VBA"宏"算的)。见下面几张图

面齿轮全貌

面齿轮与直齿啮合

现在，制造方采用数控机床按曲面加工面齿轮的齿面，要求有沿齿向的曲线坐标点，见下图

zbq2334 · 发表于 2020-7-8 22:49:30

怎么图片都没传上来？重新再传

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

通知

[求助] 导入同一文件夹下多个txt文件的宏问题

马上注册，结识高手，享用更多资源，轻松玩转三维网社区。

评分

评分

评分

评分

浏览过的版块