SW将構成3D曲線的點坐標導出到EXCEL_宏應用
功能:如主題操作說明:
1. 在SW草畫一條3D草圖.
2. 執行 main 宏.
swp檔
本帖最后由 未来第一站 于 2017-3-4 22:14 编辑
学习了。必威APP精装版下载又发现一SW高手。 未来第一站 发表于 2017-3-4 22:09
学习了。必威APP精装版下载又发现一SW高手。
回元帥此宏是收集來的,對sw個人不懂的尚多還請元帥及論壇諸前輩們多多指導啦!
如下宏可複製,分享給有需要缺資金者
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'
' 草圖點登錄到Excel檔
'
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Option Explicit
Dim swApp As Object
Dim modelDoc As Object
Dim sketch As Object
Dim objExcel As Object
Dim objWorkBook As Excel.Workbook
Dim objWorkSheet As Excel.Worksheet
Const FILE_NAME = "D:\Coordinates.xls"
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
'// Check Excel
Set objExcel = CreateObject("Excel.Application")
If objExcel Is Nothing Then
MsgBox "Cannot open Excel!"
Exit Sub
End If
Set objWorkBook = objExcel.Workbooks.Add
If objWorkBook Is Nothing Then
MsgBox "Cannot open Excel Workbook!"
Exit Sub
End If
Set objWorkSheet = objWorkBook.Worksheets(1)
If objWorkSheet Is Nothing Then
MsgBox "Cannot open Excel WorkSheet!"
Exit Sub
End If
'Extract Sketch Points
'
Dim i As Integer
Dim sketchPoints As Variant
sketchPoints = sketch.GetSketchPoints2()
'Write X, Y, Z title to Excel worksheet
'
objWorkSheet.Cells(1, 1) = "X"
objWorkSheet.Cells(1, 2) = "Y"
objWorkSheet.Cells(1, 3) = "Z"
'Write coordinates to Excel worksheet
'
For i = 0 To UBound(sketchPoints)
objWorkSheet.Cells(i + 2, 1) = Round(sketchPoints(i).X * 1000, 2)
objWorkSheet.Cells(i + 2, 2) = Round(sketchPoints(i).Y * 1000, 2)
objWorkSheet.Cells(i + 2, 3) = Round(sketchPoints(i).Z * 1000, 2)
Next i
objWorkBook.SaveAs FILE_NAME
'Close Excel
'
objWorkBook.Close
objExcel.Quit
Set objWorkSheet = Nothing
Set objWorkBook = Nothing
Set objExcel = Nothing
MsgBox "座標儲存於:" & vbCrLf & FILE_NAME
End Sub
高手！学习啦！ 很实用 本帖最后由 Miles_chen 于 2017-4-12 09:57 编辑
确实好用~
但是我下载的时候就再想，是不是只能导出样条曲线的 几个point的坐标点
还是能获得 自定义的point点数量，自动做插补导出，比如 按X轴 每隔2mm 输出一个point
果然， GetSketchPoints2() 这个函数 还是只能获得画图时候的点啊
估计要获得整段，只能用motion的结果 路径来导出吧 Miles_chen 发表于 2017-4-12 09:53
确实好用~
但是我下载的时候就再想，是不是只能导出样条曲线的 几个point的坐标点
还是能获得 自定义的po ...
//www.szfco.com/forum.php?mod=viewthread&tid=483120&pid=4170730&page=2&extra=page%3D1#pid4170730
如上#16樓的軌跡點座標,是在本主題分享的宏稍加修正得來的!
想下，没有威望啊
代码复制下来不能用啊 显示类型未定义