本帖最后由 gt.adan 于 2014-1-17 01:29 编辑
- Option Explicit
- Dim swApp As Object
- Dim modelDoc As SldWorks.ModelDoc2
- Dim sketch As SldWorks.ISketch
- Const FILE_NAME = "D:\Coordinates.txt"
- Sub main()
- Set swApp = Application.SldWorks
- Set modelDoc = swApp.ActiveDoc
- '// Check active document
- '
- If modelDoc Is Nothing Then
- MsgBox "No active document!"
- Exit Sub
- End If
- '// get active sketch
- '
- Set sketch = modelDoc.SketchManager.ActiveSketch
- If sketch Is Nothing Then
- MsgBox "No active Sketch!"
- Exit Sub
- End If
-
- '// Output to file
- Dim iFileNum As Integer
- iFileNum = FreeFile()
- Open FILE_NAME For Output As iFileNum
- Dim i As Integer
- Dim sketchPoints As Variant
- sketchPoints = 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) & ")"
- Next i
- Close iFileNum
- MsgBox "座标储存於:" & vbCrLf & FILE_NAME
- End Sub
复制代码 |