export sketch points
export sketch points
(OP)
I have created a complex curve from 100 approx points, manually imputed. Is there a way of exporting these points to enable me to put them into a table?
Or do I have to manually repeat the exercise, (note the original excel file is not available original a hard copy)
Or do I have to manually repeat the exercise, (note the original excel file is not available original a hard copy)






RE: export sketch points
How about this.
Ken
CODE
'instructions:
'select the sketch that you wish to "read" and run the macro.
Option Explicit
Dim swApp As SldWorks.SldWorks
Dim swModelDoc As SldWorks.ModelDoc2
Dim selMgr As SldWorks.SelectionMgr
Dim swFeature As SldWorks.feature
Dim swSketchFeature As SldWorks.feature
Dim i As Long
Dim swSketchPoints As Variant
Dim ep As SldWorks.SketchPoint
Dim PointCount As Integer
Dim SketchPointCoords(2) As Double
Dim SketchPointXVal() As Double
Dim SketchPointYVal() As Double
Dim SketchPointZVal() As Double
Dim MathUtil As SldWorks.MathUtility
Dim MathTrans As SldWorks.MathTransform
Dim MathP As SldWorks.MathPoint
Dim ModelSketchTransform As Variant
Sub main()
Set swApp = Application.SldWorks
If Not swApp Is Nothing Then
Set MathUtil = swApp.GetMathUtility
Set swModelDoc = swApp.ActiveDoc
If Not swModelDoc Is Nothing Then
If swModelDoc.GetType = swDocPART Then
Set selMgr = swModelDoc.SelectionManager
If Not selMgr Is Nothing Then
If selMgr.GetSelectedObjectType2(1) = swSelSKETCHES Then
Set swFeature = selMgr.GetSelectedObject5(1)
Set swSketchFeature = swFeature.GetSpecificFeature2
If Not swSketchFeature Is Nothing Then
swSketchPoints = swSketchFeature.GetSketchPoints
PointCount = UBound(swSketchPoints)
If PointCount > 0 Then
ReDim SketchPointXVal(UBound(swSketchPoints))
ReDim SketchPointYVal(UBound(swSketchPoints))
ReDim SketchPointZVal(UBound(swSketchPoints))
For i = 0 To PointCount
SketchPointXVal(i) = swSketchPoints(i).x
SketchPointYVal(i) = swSketchPoints(i).y
SketchPointZVal(i) = swSketchPoints(i).z
Next i
Open "C:\Temp\SWDataPoints.dat" For Output As #1
Print #1, "Sketch Coordinate System,,,Model Coordinate System"
Print #1, "Sketch-X,Sketch-Y,Sketch-Z,Model-X,Model-Y,Model-Z"
For i = 0 To PointCount
SketchPointCoords(0) = SketchPointXVal(i)
SketchPointCoords(1) = SketchPointYVal(i)
SketchPointCoords(2) = SketchPointZVal(i)
Set MathP = MathUtil.CreatePoint(SketchPointCoords)
Set MathTrans = swSketchFeature.ModelToSketchTransform
Set MathTrans = MathTrans.Inverse
Set MathP = MathP.MultiplyTransform(MathTrans)
swSketchPoints = MathP.ArrayData
Print #1, FormatNumber(SketchPointXVal(i) * 1000 / 25.4, 8) & "," & FormatNumber(SketchPointYVal(i) * 1000 / 25.4, 8) & "," & FormatNumber(SketchPointZVal(i) * 1000 / 25.4, 8) & "," & FormatNumber(swSketchPoints(0) * 1000 / 25.4, 8) & "," & FormatNumber(swSketchPoints(1) * 1000 / 25.4, 8) & "," & FormatNumber(swSketchPoints(2) * 1000 / 25.4, 8)
Next i
Close #1
End If
End If
End If
End If
End If
End If
End If
End Sub
RE: export sketch points
RE: export sketch points
"is this my only option, I have not had dealings with this sort of thing before"
This macro will export the point locations (in 2 coordinate systems) to a text file. If you assign this macro to a toolbar button you can use it repeatedly to do this operation. It will require one click of the toolbar button to run the macro.
Are you looking for a solution that requires less than one button click? If so, please include that as one of your requirements when asking the question so that people don't waste their time posting answers which do not meet your expectations.
A star for Ken.
RE: export sketch points
Fill what's empty. Empty what's full. And scratch where it itches.