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

zbq2334

/ F& m3 P: @) V; C

- B- ^% H6 A$ E: }" t9 i
面齿轮全貌
1 p6 _  e. G  t/ V  ~5 `9 u3 U' r' g

$ E0 n  ~2 w/ Y) y* @5 A$ Y; p: g
/ _5 M. ^2 o0 Q, V1 _面齿轮与直齿啮合


现在，制造方采用数控机床按曲面加工面齿轮的齿面，要求有沿齿向的曲线坐标点，见下图
- j6 U9 R0 s. g6 Y1 r/ w
6 Z* G8 w$ H2 h! n图中沿齿向，我做了5条曲线，在3D草图上取点做的曲线，用的是一位大师的"取草图点的宏"，做了一些适应性小改动。
2 _( p. M( e! Z2 K4 H, d恳请两位老师帮帮我，做个"宏"，批量做出齿向曲线坐标点(这是与5条曲线一个模式的，5条是其中的)。下面我传上SW文件和"取草图点的宏"代码
  e, G8 Y9 S0 Z) e# V7 f2 Q- R

" ?! v" `$ Z! K8 j# f

面齿轮齿面上沿齿向的曲线.zip (246.9 KB, 下载次数: 0)

2020-7-8 23:12 上传

点击文件名下载附件

/ w( ]) v8 L0 ^7 F' L

/ x3 V0 l2 ?' u3 [1 S

. P' B$ o/ g: w# R/ x9 V

Dim sketch As SldWorks.ISketch

( F9 u% R1 f3 A

'Const FILE_NAME = "D:\Coordinates.txt"
% B  C* O+ g) A# ^6 t- N) _'Const FILE_NAME = "D:\Coordinates.txt"
# H- C9 V! O# G% |3 oConst FILE_NAME = "D:\Coordinates.sldcrv"

Sub main()
Set swApp = Application.SldWorks
Set modelDoc = swApp.ActiveDoc
( p9 h2 ]0 c0 r( s# j, G) J'// Check active document
'
; h* D9 F' b) l6 E# L6 a' e7 ~7 VIf modelDoc Is Nothing Then
MsgBox "No active document!"
Exit Sub
End If

'// get active sketch
% O1 |+ f& a: p* j'
Set sketch = modelDoc.SketchManager.ActiveSketch
- H; h) {0 r3 g' b. M5 n. eIf sketch Is Nothing Then
& d' p0 J( j# bMsgBox "No active Sketch!"
  D+ U9 B/ w% W3 n5 |% P; LExit Sub
End If
2 @. o% q+ `% v" S3 I7 ?3 t: c   
6 g+ c: A* I. v7 Z# L'// Output to file
Dim iFileNum As Integer
iFileNum = FreeFile()
Open FILE_NAME For Output As iFileNum
9 y) Q  p6 J- T7 \7 C! y4 r, oDim i As Integer
7 W9 r( a" m2 g+ _7 f  L# ODim sketchPoints As Variant
8 p, ]7 x# }( M3 d# M0 ^- dsketchPoints = sketch.GetSketchPoints2()
For i = 0 To UBound(sketchPoints)

'Print #iFileNum, "(" & Round(sketchPoints(i).X * 1000, 2) & "," & Round(sketchPoints(i).Y * 1000, 2) & ", " & Round(sketchPoints(i).Z * 1000, 2) & ")"

1 {4 O, z% p: C3 ^. f0 q( A) o. p& D

Print #iFileNum, Round(sketchPoints(i).X * 1000, 5) & "," & Round(sketchPoints(i).Y * 1000, 5) & ", " & Round(sketchPoints(i).Z * 1000, 5)

* @% D" r, ?* b! P

Next i
! G; `" t, U, [3 ?& t) t7 D- DClose iFileNum
: i! T; _7 `8 @MsgBox "坐标储存于:" & vbCrLf & FILE_NAME
End Sub

" G* C- c9 J. ]$ |3 S

+ R( t/ G9 j. h& i
# c2 k4 \; |( `7 y; B; x
2 k5 Z+ H1 h2 s. }: Y( Q7 D7 {* I

zbq2334

批量做齿向的曲线，比较密，间隔0.025mm，整个齿高上有100条曲线，一条一条做重复劳动工作量大。
$ `* [- |$ j$ V3 Y+ A  W) V, m/ U+ V我的思路是循环语句一步一步地改变3D草图的基准面到坐标原点的距离，从而得到一系列坐标点，然后取出坐标点成.sldcrv文件……可是我不会"改变3D草图的基准面到坐标原点的距离"宏语句，非常希望得到两位老师的指导和帮助，我先谢谢你们了。

zbq2334

年纪大了，老眼昏花，传图也没传好，啰里啰嗦，可能也没说到点子上，耽误两位老师的时间了，非常抱歉。