Hello all,
I am in the ongoing process of writing a macro to extract the line and unit vectors from multiple lines, and am close to getting there except for some trouble with transforming the sketch coordinates to model coordinates. I’m only trying to transform the start point now, but will want to transform the end point, line vector, and unit vector as well in both the message box and Excel. Currently, when I try to run it, the message box comes up blank. I have a feeling something simple is wrong, but I’m just not sure what it is. Here’s the code I have so far:
Option Explicit
Dim xlApp As Excel.Application
Dim xlWorkbook As Excel.Workbook
Public Function GetModelCoordinates _
( _
swApp As SldWorks.SldWorks, _
swSketch As SldWorks.Sketch, _
vPtArr As Variant _
) As Variant
Dim swMathPt As SldWorks.MathPoint
Dim swMathUtil As SldWorks.MathUtility
Dim swMathTrans As SldWorks.MathTransform
Set swMathUtil = swApp.GetMathUtility
Set swMathPt = swMathUtil.CreatePoint(vPtArr)
Set swMathTrans = swSketch.ModelToSketchTransform
Set swMathTrans = swMathTrans.Inverse
Set swMathPt = swMathPt.MultiplyTransform(swMathTrans)
GetModelCoordinates = swMathPt.ArrayData
End Function
Sub Main()
On Error Resume Next
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swMathUtil As SldWorks.MathUtility
Dim swSelMgr As SldWorks.SelectionMgr
Dim swSketchLine As SldWorks.SketchLine
Dim oMyLine As Object
Dim oMathVector As SldWorks.MathVector
Dim oUnitVector As SldWorks.MathVector
Dim vPt1 As Variant
Dim vPt2 As Variant
Dim dArr(2) As Double
Dim i As Long
Dim j As Long
Dim l As Long
Dim m As Long
Dim n As Long
Dim dArrUnit As Variant
Dim bRes As Boolean
Dim Message As String
Dim startRow As Double
Dim swStartPt As SldWorks.SketchPoint
Dim swEndPt As SldWorks.SketchPoint
Dim NumberOfSelectedItems
Dim swSelBody As SldWorks.Body2
Dim vModelSelPt1 As Variant
Dim swSketch As SldWorks.Sketch
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swSelMgr = swModel.SelectionManager
Set swSketch = swModel.GetActiveSketch2
If Not swApp Is Nothing Then
Set swModel = swApp.ActiveDoc
Set swMathUtil = swApp.GetMathUtility
If Not swModel Is Nothing And Not swMathUtil Is Nothing Then
Set swSelMgr = swModel.SelectionManager
NumberOfSelectedItems = swSelMgr.GetSelectedObjectCount2(-1)
If NumberOfSelectedItems > 0 Then
'initialize Excel
Call GetExcel
End If
For l = 1 To NumberOfSelectedItems
Set swSketchLine = swSelMgr.GetSelectedObject6(l, -1)
If Not swSketchLine Is Nothing Then
Set swEndPt = swSketchLine.GetEndPoint2
Set swStartPt = swSketchLine.GetStartPoint2
dArr(0) = swEndPt.X
dArr(1) = swEndPt.Y
dArr(2) = swEndPt.Z
vPt2 = dArr
dArr(0) = swStartPt.X
dArr(1) = swStartPt.Y
dArr(2) = swStartPt.Z
vPt1 = dArr
dArr(0) = vPt2(0) - vPt1(0)
dArr(1) = vPt2(1) - vPt1(1)
dArr(2) = vPt2(2) - vPt1(2)
Set oMathVector = swMathUtil.CreateVector(dArr)
swStartPt = swSelMgr.GetSelectionPointInSketchSpace(1)
vModelSelPt1 = GetModelCoordinates(swApp, swSketch, swStartPt)
If Not oMathVector Is Nothing Then
Set oUnitVector = oMathVector.Normalise()
dArrUnit = oUnitVector.ArrayData()
Message = Message & "Magnitude for start point is " & vbCrLf & "X: " & (vModelSelPt1(0) * 1000) & " mm" & " Y: " & (vModelSelPt1(1) * 1000) & " mm" & " Z: " & (vModelSelPt1(2) * 1000) & " mm" & vbCrLf & "Magnitude for end point is " & vbCrLf & "X: " & (swEndPt.X * 1000) & " mm" & " Y: " & (swEndPt.Y * 1000) & " mm" & " Z: " & (swEndPt.Z * 1000) & " mm" & vbCrLf & "Line vector is " & dArr(0) & "i + " & dArr(1) & "j + " & dArr(2) & "k" & vbCrLf & "Unit vector is " & dArrUnit(0) & "i + " & dArrUnit(1) & "j + " & dArrUnit(2) & "k" & vbCrLf
Set oUnitVector = Nothing
Set oMathVector = Nothing
End If
'write two lines to Excel, so startrow is counted by 2
bRes = WriteToExcel(((l - 1) * 8) + 1, vPt1, "Magnitude for Start Point")
bRes = WriteToExcel(((l - 1) * 8) + 3, vPt2, "Magnitude for End Point")
bRes = WriteToExcel(((l - 1) * 8) + 5, dArr, "Line Vector")
bRes = WriteToExcel(((l - 1) * 8) + 7, dArrUnit, "Unit Vector")
End If
Next l
startRow = 1
For m = 1 To NumberOfSelectedItems
For n = 1 To 3 Step 2
With xlWorkbook.ActiveSheet
startRow = (8 * m) + n - 4
.Cells(startRow, 1).Value = "i"
.Cells(startRow, 2).Value = "j"
.Cells(startRow, 3).Value = "k"
End With
Next n
Next m
Set oMyLine = Nothing
Set swSelMgr = Nothing
Set swSketchLine = Nothing
End If
Set swModel = Nothing
Set swMathUtil = Nothing
End If
'show the message
MsgBox Message
End Sub
Private Sub GetExcel()
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
Set xlWorkbook = xlApp.Workbooks.Add
End Sub
Private Function WriteToExcel(startRow As Integer, data As Variant, Optional label As String = "") As Boolean
'get the results into excel
With xlWorkbook.ActiveSheet
.Cells(startRow, 1).Value = "X"
.Cells(startRow, 2).Value = "Y"
.Cells(startRow, 3).Value = "Z"
.Cells(startRow, 4).Value = label
.Cells(startRow + 1, 1).Value = data(0)
.Cells(startRow + 1, 2).Value = data(1)
.Cells(startRow + 1, 3).Value = data(2)
End With
End Function
I also tried Matt Martens’ suggestion of setting vPtModelSel1 to model arrays but that did not work either; they show up as 0:
Dim vModelSelPt1(2) As Double
Message = Message & "Magnitude for start point is " & vbCrLf & "X: " & (vModelSelPt1(0) * 1000) & " mm" & " Y: " & (vModelSelPt1(1) * 1000) & " mm" & " Z: " & (vModelSelPt1(2) * 1000) & " mm" & vbCrLf & "Magnitude for end point is " & vbCrLf & "X: " & (swEndPt.X * 1000) & " mm" & " Y: " & (swEndPt.Y * 1000) & " mm" & " Z: " & (swEndPt.Z * 1000) & " mm" & vbCrLf & "Line vector is " & dArr(0) & "i + " & dArr(1) & "j + " & dArr(2) & "k" & vbCrLf & "Unit vector is " & dArrUnit(0) & "i + " & dArrUnit(1) & "j + " & dArrUnit(2) & "k" & vbCrLf
https://forum.solidworks.com/thread/91728
SolidworksApi macros