Sketch Point Import Macro Mod

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.

Here is another example on CS transformation, from CodeStack:

https://www.codestack.net/solidworks-api/geometry/transformation/get-coordinate-system-transform/

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.

I stumbled across this macro today and it was exactly what I needed. Thank you.

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

icons in ZIP:
points.png
points cloud CSV.zip (1.04 KB)