Solidworks API Programming: Centerline Macro

Solidworks API Programming Part 2:
Sketching the cross center line on random rectangular surface

Precisely speaking, this program is for the random surface which has even number of edges. Nevertheless, this program is used to draw centerline within sketch on the surface. No matter how it forms angle with front, top or right plane, program should sketch the centerline correctly. So it's not simple. To do so, I need to consider transformation between 3D space and 2D sketch coordinates. Of course This kind of transformation function is supported by Solidworks API. Way to go!

1. Make new macro
Just click Tools - Macro - New

2. Source code analysis
In VBA, Comment symbol is ' (single quotation) and Continuation symbol is _ (underscore).

'--------------------------------------
'
' Preconditions:
'       (1) Part or assembly is open.
'       (2) Face is selected.
'
' Postconditions: Plane or face on which
'                 selected sketch was drawn is selected.
'
'--------------------------------------

Option Explicit

Sub main()

    Dim pSWApp   As SldWorks.SldWorks
    Dim pModel   As SldWorks.ModelDoc2
    Dim pSelMgr   As SldWorks.SelectionMgr
    Dim pSketch   As SldWorks.Sketch
    Dim pSketchSeg  As SldWorks.SketchSegment
    Dim pFace   As SldWorks.Face2
    Dim swLoop   As SldWorks.Loop2
    Dim swEdge   As SldWorks.Edge
    Dim vEdgeArr  As Variant
    Dim vEdge   As Variant
    Dim swCurve   As SldWorks.Curve
    Dim swSketch  As SldWorks.Sketch
    Dim swSketchSeg  As SldWorks.SketchSegment
    Dim swXForm  As SldWorks.MathTransform
    Dim swMathUtil  As SldWorks.MathUtility
    Dim swMathStartPt As SldWorks.MathPoint
    Dim swMathEndPt  As SldWorks.MathPoint

    Dim vMidPts   As Variant
    Dim vCurveParam  As Variant
    Dim nStartPt(2)  As Double
    Dim nEndPt(2)  As Double
    Dim nEdgeCount  As Long
    Dim i    As Long
    Dim j    As Long
    Dim bRet   As Boolean
    Dim boolstatus  As Boolean


    Set pSWApp = CreateObject("SldWorks.Application")
    Set pModel = pSWApp.ActiveDoc
    Set pSelMgr = pModel.SelectionManager
    Set pFace = pSelMgr.GetSelectedObject6(1, 0)

    If pFace Is Nothing Then
        boolstatus = pSWApp.SendMsgToUser2("Please select a face", _
                                            swMbWarning, swMbOk)
        Exit Sub
    End If

    pModel.InsertSketch2 True
    pModel.SetAddToDB True

    
    'Doesn't show the changes during the program execution 
    pModel.SetDisplayWhenAdded False 
            
    Set pSketch = pModel.GetActiveSketch2
    Set swXForm = pSketch.ModelToSketchTransform 'Transform from model to sketch
    Set swMathUtil = pSWApp.GetMathUtility

    
    'Find loops of closed edges on the selected surface
    Set swLoop = pFace.GetFirstLoop   
    While Not swLoop Is Nothing        
        i = i + 1        
        Debug.Print "Loop(" & i & ")"       
        Debug.Print "  IsOuter    = " & swLoop.IsOuter       
        Debug.Print "  IsSingular = " & swLoop.IsSingular        
        Debug.Print ""
    
        
        'Find the outer loop       
        If swLoop.IsOuter Then            
        vEdgeArr = swLoop.GetEdges: Debug.Assert UBound(vEdgeArr) >= 0            
        nEdgeCount = swLoop.GetEdgeCount
            
            
            'Even number of edges are available here.
            If Not nEdgeCount Mod 2 = 0 Then               
                boolstatus = pSWApp.SendMsgToUser2( _
                   "Please select the rectangular face...", _
                    swMbWarning, swMbOk)
                pModel.InsertSketch2 True
                bRet = pModel.EditRebuild3: Debug.Assert bRet
                Exit Sub
            End If
         
            
            'Finding edges
            '4 for rectangle
            '6 for hexagon
            '0 for circle
            i = 0
            ReDim vMidPts(nEdgeCount * 3)
            For Each vEdge In vEdgeArr
                Set swEdge = vEdge
                vCurveParam = swEdge.GetCurveParams2
      
                
                'vCurveParam is a array which contains 11 double type data as follows
                'StartPtX, StartPtY, StartPtZ,
                'EndPtX, EndPtY, EndPtZ,
                'StartUParam, EndUParam,
                'PackDouble1, PackDouble2, PackDouble3
                For j = 0 To 2
                    nStartPt(j) = vCurveParam(j)
                    nEndPt(j) = vCurveParam(j + 3)
                Next j
              
                 
                'If you use 3D sketch, you don't have to do this kind of transformation
                'Using sketch let us need to do the transformation
                '3D coordinate values of array(nStartPt) are
                'assigned to vector (swMathStartPt)
                'and then, 3D values are transformed into 2D values
                'swXForm = pSketch.ModelToSketchTransform is
                'the transfromation function of API to do so.
                Set swMathStartPt = swMathUtil.CreatePoint((nStartPt))
                Set swMathStartPt = swMathStartPt.MultiplyTransform(swXForm)
                Set swMathEndPt = swMathUtil.CreatePoint((nEndPt))
                Set swMathEndPt = swMathEndPt.MultiplyTransform(swXForm)                
          
                
                'Transformed vector values are assinged to new array(vMidPts).
               For j = 0 To 2
                    vMidPts(i) = (swMathStartPt.ArrayData(j) + _
                                        swMathEndPt.ArrayData(j)) / 2#
                    i = i + 1
               Next j
            Next vEdge
            
         
            'In vMidPts
            '1st edge mid-point:0,1,2
            '2nd edge mid-point:3,4,5
            '3rd edge mid-point:6,7,8
            '...
            'saved like this.
            'mid-points are connected skipping the right next points.
            'so, practically centerline is formed only on the rectangle


         
            'If you want to apply this program to skewed surface, you can test as follows.
            'Draw (0,0)-(1,0), (0,0)-(0,1)
            'You can check the sketch and space coordinates in this way.
            On Error Resume Next
            For i = 0 To nEdgeCount / 2 - 1
                Set swSketchSeg = pModel.CreateLine2( _
                    vMidPts(i * 3 + 0), vMidPts(i * 3 + 1), 0, _
                    vMidPts(i * 3 + nEdgeCount * 3 / 2), vMidPts(i * 3 + nEdgeCount * 3 / 2 + 1), 0)
                swSketchSeg.ConstructionGeometry = True
                Debug.Print "vMidPts-from (" & i & ") = " & _
                    Format$(vMidPts(i * 3 + 0) * 1000#, "0.0000") & "," & _
                    Format$(vMidPts(i * 3 + 1) * 1000#, "0.0000") & " mm"
                Debug.Print "vMidPts-to   (" & i & ") = " & _
                    Format$(vMidPts(i * 3 + nEdgeCount * 3 / 2) * 1000#, "0.0000") & "," & _
                    Format$(vMidPts(i * 3 + nEdgeCount * 3 / 2 + 1) * 1000#, "0.0000") & " mm"
            Next i
            On Error GoTo 0
        End If
        Set swLoop = swLoop.GetNext
    Wend

    

    'All changes are reflected on the screen.
    pModel.SetDisplayWhenAdded True
    pModel.SetAddToDB False

    

    'If you want to continue to do something within sketch mode, 
    'comment out the following code this way.
    'pModel.InsertSketch2 True
    'bRet = pModel.EditRebuild3: Debug.Assert bRet
End Sub