Probably one for Artem but just in case anyone else knows how:
I want to create a sketch with a bunch of known points (that I already have in CSV format) so this macro is pretty much perfect.
However rather than using the global coordinate system, I was hoping to use a coordinate system I have inserted to define the origin for where the points are placed. Can this macro be modified to prompt me to select a different coordinate system?
Also less critically, my data is natively in mm where the macro requires metres. Obviously it is trivial to update the source data but it would be one less step if maybe the macro could read the document units and import as that, would that be possible?
I feel like you’d have to transform the coordinates to the reference coordinate system with something like:
Yes, this would be relatively simple to create a conversion function that looks for common units and applies a conversion to any measurements during the import of all the points from your CSV. Meters is such an uncommon unit that you would likely have to convert units anyway.
dave.laban, I have updated the original macro and you can now pre-select coordinate system to import points relative to. And you also have an option to import points using the current document coordinate system. I have updated the macro and you can redownload from CodeStack. Please let me know if you have any questions.
Since I’ve already come to this topic, I’ll leave this here too:
Macro for exporting all sketch points to a CSV file
Sub main()
On Error GoTo ErrorHandler
Set swApp = Application.SldWorks
Dim swModel As SldWorks.ModelDoc2
Set swModel = swApp.ActiveDoc
If swModel Is Nothing Then
MsgBox "Please open the document before running the macro.", vbExclamation, "Error"
Exit Sub
End If
Dim swSketch As SldWorks.Sketch
Set swSketch = swModel.SketchManager.ActiveSketch
If swSketch Is Nothing Then
MsgBox "Please select or open a thumbnail before running the macro.", vbExclamation, "Error"
Exit Sub
End If
' Dim swSketchPoints As ISketchPoint
Dim swSketchPointsV As Variant
swSketchPointsV = swSketch.GetSketchPoints2
If UBound(swSketchPointsV) < 0 Then
MsgBox "The sketch does not contain any points.", vbExclamation, "Error"
Exit Sub
End If
Dim modelPath As String
modelPath = swModel.GetPathName()
If modelPath = "" Then
MsgBox "Model file not saved. Please save the file before exporting.", vbExclamation, "Error"
Exit Sub
End If
Dim savePath As String
savePath = Left(modelPath, InStrRev(modelPath, ".") - 1) & "_Points.csv"
Dim fileNo As Integer
fileNo = FreeFile
Open savePath For Output As #fileNo
' Adding a Header to CSV
Print #fileNo, "X;Y;Z"
Dim i As Integer
For i = 0 To UBound(swSketchPointsV)
Dim swPoint As SldWorks.SketchPoint
Set swPoint = swSketchPointsV(i)
If Not swPoint Is Nothing Then
Dim x As Double, y As Double, z As Double
x = swPoint.x * 1000 ' Convert to mm
y = swPoint.y * 1000 ' Convert to mm
z = swPoint.z * 1000 ' Convert to mm
' Write coordinates to CSV
Print #fileNo, x & ";" & y & ";" & z
End If
Next i
Close #fileNo
MsgBox "Points successfully exported to file: " & savePath, vbInformation, "Successfully"
Exit Sub
ErrorHandler:
MsgBox "Error: " & Err.Description, vbCritical, "Error"
On Error GoTo 0
End Sub
Another macro to Create an anchor point on each point of this sketch
' ****************************************************************************
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swSelMgr As SldWorks.SelectionMgr
Dim swFeature As SldWorks.Feature
Dim swSketch As SldWorks.Sketch
Dim swFeatMgr As SldWorks.FeatureManager
Dim swSketchPoint As SldWorks.SketchPoint
Dim vSketchPoints As Variant
Dim i As Integer
Sub Main()
' Initialize objects
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
If swModel Is Nothing Then
MsgBox "No active document. Open model and select sketch."
Exit Sub
End If
' Get the selection manager
Set swSelMgr = swModel.SelectionManager
' Check that a Feature object (sketch) is selected
If swSelMgr.GetSelectedObjectType3(1, -1) <> swSelectType_e.swSelSKETCHES Then
MsgBox "Please select one sketch before running the macro."
Exit Sub
End If
' Get the selected Feature
Set swFeature = swSelMgr.GetSelectedObject6(1, -1)
If swFeature Is Nothing Then
MsgBox "Unable to get the selected Feature. Make sure you have selected a sketch." Exit Sub
End If
' Convert Feature to Sketch
Set swSketch = swFeature.GetSpecificFeature2
If swSketch Is Nothing Then
MsgBox "Unable to convert Feature to Sketch. Make sure you have selected a sketch."
Exit Sub
End If
' Get FeatureManager to add ReferencePoints
Set swFeatMgr = swModel.FeatureManager
' Loop through all sketch points
vSketchPoints = swSketch.GetSketchPoints2
If IsEmpty(vSketchPoints) Then
MsgBox "There are no points in the selected sketch." Exit Sub
End If
' Create ReferencePoints for each sketch point
For i = LBound(vSketchPoints) To UBound(vSketchPoints)
Set swSketchPoint = vSketchPoints(i)
' Create a ReferencePoint based on SketchPoint
swModel.ClearSelection2 True ' Make sure there are no extra selections
swSketchPoint.Select4 True, Nothing ' Select the current point
' Call InsertReferencePoint
swFeatMgr.InsertReferencePoint 7, 2, 0, 1
Next i
MsgBox "ReferencePoints have been successfully created for all sketch points."
' Clear selections
swModel.ClearSelection2 True
End Sub
