edgeDetect.swp

 
'Pre-conditions: Adjust line 36 of the macro to point to your default solidworks part file
'Prec-onditions: Adjust line 40 to point to an image file that contains white and non white pixels
'Purpose: This macro draws a circle over every non white pixel that borders a white pixel
'Result: Every edge pixel will have a circle drawn on it'
'Result: An array is populated with the X and Y locations of every edge pixel for future development'
 
Option Explicit
Dim swApp As SldWorks.SldWorks
Public swModel As SldWorks.ModelDoc2
Dim swFeat As SldWorks.Feature
Dim swSketchPicture As SldWorks.ISketchPicture
Dim swSelMgr As SldWorks.SelectionMgr
Dim boolstatus As Boolean
Public w As Long
Public h As Long
Public width As Double
Public height As Double
Dim xx As Double
Dim yy As Double
Public i As Long
Public j As Long
Public RGBs
Public pixels
Public rgbArray() As Integer
Public k As Long
Public xPos As Integer
Public yPos As Double
Public skSegment As Object
Public d As Long
Dim myArray() As Double
Public white As Boolean
 
Sub main()
    Set swApp = Application.SldWorks
    Set swModel = swApp.NewDocument("C:\ProgramData\SolidWorks\SOLIDWORKS 2017\templates\Part.prtdot", 0, 0, 0) 'This line opens up SolidWorks default part document.  If you do not have SW 2017, or you have installed SolidWorks to a different location, this line will need to be changed.'
    Set swModel = swApp.ActiveDoc
    Set swSelMgr = swModel.SelectionManager
    swModel.SketchManager.InsertSketch True
    Set swSketchPicture = swModel.SketchManager.InsertSketchPicture("C:\Users\Atom\Pictures\p.jpg")
    swModel.SketchManager.InsertSketch True
    boolstatus = swModel.Extension.SelectByID2("Sketch1", "SKETCH", 0, 0, 0, False, 0, Nothing, 0)
    swModel.EditSketch
    boolstatus = swModel.Extension.SelectByID2("Sketch Picture1", "SKETCHBITMAP", 0, 0, 0, False, 0, Nothing, 0)
    Set swFeat = swSelMgr.GetSelectedObject6(1, -1)
    swSketchPicture.GetOrigin xx, yy
    swSketchPicture.GetSize width, height
    RGBs = swSketchPicture.GetPixelmapSize(w, h)
    pixels = RGBs / 3
    rgbArray = swSketchPicture.GetPixelmap()  'this is an array with every rgb value of the image, starting in the upper left and ending lower right'
    drawLine
End Sub
 
Sub drawLine()
    Dim instance As ISketchManager
    Set instance = swModel.SketchManager
    instance.AddToDB = True
    d = 0
    j = 0
    For i = 0 To pixels
        white = False
        If (d + 3 * w) < RGBs Then
            If (rgbArray(d + 3 * w) + rgbArray(d + 1 + 3 * w) + rgbArray(d + 2 + 3 * w) > 750) Then   'if pixel below is white'
            white = True
            End If
        End If
        If white = False And d > 2 + 3 * w Then
            If rgbArray(d - 3 * w) + rgbArray(d + 1 - 3 * w) + rgbArray(d + 2 - 3 * w) > 750 Then     'if pixel above is white'
            white = True
            End If
        End If
        If white = False And d > 0 Then
            If rgbArray(d - 3) + rgbArray(d - 2) + rgbArray(d - 1) > 750 Then          'if pixel to the left is white'
            white = True
            End If
        End If
        If white = False And d < RGBs - 3 Then
            If rgbArray(d + 3) + rgbArray(d + 4) + rgbArray(d + 5) > 750 Then           'if pixel to the right is white'
            white = True
            End If
        End If
 
        If d / 3 < pixels Then
            If (rgbArray(d) + rgbArray(d + 1) + rgbArray(d + 2) < 761 And white) Then
                If isFar(j, (d / 3 Mod w) / w * width + 0.5 * width / w, height - Int(d / 3 / w) / h * height - 0.5 * height / h) Then
                myArray(0, j) = (d / 3 Mod w) / w * width + 0.5 * width / w               'X value'
                myArray(1, j) = height - Int(d / 3 / w) / h * height - 0.5 * height / h   'Y value'
                Set skSegment = swModel.SketchManager.CreateCircle(myArray(0, j), myArray(1, j), 0#, myArray(0, j), myArray(1, j) + height / h * 0.5, 0#)
                j = j + 1
                End If
            End If
        End If
    d = d + 3
    Next i
    instance.AddToDB = False
End Sub
 
Public Function isFar(arrayElement As Long, xPos As Double, yPos As Double) As Boolean
isFar = True
If arrayElement = 0 Then
    ReDim Preserve myArray(1, arrayElement)
    myArray(0, arrayElement) = xPos
    myArray(1, arrayElement) = yPos
    Exit Function
End If
 
For k = arrayElement To 1 Step -1 'here we make sure the current pixel woot s location is at least 1 pixel length from all other edge pixels'
    If (xPos - myArray(0, k - 1)) ^ 2 + (yPos - myArray(1, k - 1)) ^ 2 < (height / h) ^ 2 - 0.00000254 Then
    'If (xPos - myArray(0, k - 1)) ^ 2 + (yPos - myArray(1, k - 1)) ^ 2 < (height / h + height / h) ^ 2 - 0.00000254 Then'
        isFar = False
        Exit Function
    End If
Next k
ReDim Preserve myArray(1, arrayElement) 'only the last dimension of an array can be redimensioned'
myArray(0, arrayElement) = xPos
myArray(1, arrayElement) = yPos
End Function
 

      If you comment out line 108 with an apostrophe and uncomment line 109 each edge pixel must be 2 pixel lengths apart to have a circle drawn over top of it or to be added to the array of edge pixels. Your result should look like the following image:

Notes:

SolidWorks macros must be written with meters not inches. 1 meter equals .0254 inches.

Because of snapping, most circles would not draw properly while this macro ran. This is no longer a problem. The solution to this issue is found on or around line 57 of the main code: part.SketchManager.AddToDB = True This line of code bypasses the snapping portion of the drawing process. Line 95 returns the value to False although without line 95 I've never had a problem.

Line 77 of the macro populates an array with every rgb value in your image. For instance rgbArray(0) is the red value of the first pixel which is in the upper left corner of the image. rgbArray(1) is the green value of the first pixel. and rgbArray(2) is the blue value for pixel 1. The order of pixels in the array is left to right, top to bottom. So the last pixel value in the array is the blue value of the lower right hand corner's pixel.

Only the last dimension of an array in VBA can be redimensioned if you want to Preserve the original data in the array. For this reason the macro populates the array myArray in a strange way on line 101. The first dimension always only has 2 elements 0 and 1 but the 2nd dimension becomes larger every time a pixel meets the isFar functions criteria for being True.

The VBA logical operator AND causes the 2nd boolean expression to be evaluated even if the first boolean expression evaluates to false. For this reason I use nested if-then statements instead of the AND operator. With thousands or tens of thousands of pixels to be evaluated this can shave seconds off execution time.