Distance Mate Macro
Distance Mate Macro
(OP)
I posted some quickie mate macros some time back for coincident, concentric, and parallel mates in thread559-175155: Plane/Origin Selection Macro. I'd been wanting to do a distance mate, but I liked the SW functionality that uses the current distance between the chosen components as the default distance. Calculating this distance turned out to be pretty involved, especially calculating normal distances (which was what the default SW mate function does) rather than just the shortest distance.
This macro, like the other macros, is faster than the standard way of adding mates (especially for larger assemblies) because it doesn't use the mate property manager and doesn't do a rebuild after adding each mate. It also saves mouse clicks by allowing you to enter a negative value for the dimension rather than having to check a box or click a button.
Hope it can be a help to others...
This macro, like the other macros, is faster than the standard way of adding mates (especially for larger assemblies) because it doesn't use the mate property manager and doesn't do a rebuild after adding each mate. It also saves mouse clicks by allowing you to enter a negative value for the dimension rather than having to check a box or click a button.
Hope it can be a help to others...
CODE
Const SF As Double = 1000 'scale factor.
'Change the scale factor value above based on your
'standard unit system. Use:
'1000 for mm
'100/2.54 for inches
Sub main()
Dim CurDist As Double
Dim NewDist As Double
Dim CurFlip As Boolean
Dim NewFlip As Boolean
Dim cnt As Long
Dim myMateDim As SldWorks.Dimension
Dim InPutStr As String
Dim swApp As SldWorks.SldWorks
Dim swDoc As SldWorks.ModelDoc2
Dim swAssy As SldWorks.AssemblyDoc
Dim swSelMgr As SldWorks.SelectionMgr
Dim swMate As SldWorks.Mate2
Dim ErrorLong As Long
Dim MsgReply As Integer
Dim NewAlign As Long
Dim sMsg As String
Dim sMateName As String
sMsg = "Enter desired mate distance" & vbCrLf & _
"Enter a negative number to flip the dimension and change value." & vbCrLf & _
"Enter ""-"" alone to flip current value shown" & _
"To accept the current value, Cancel or press Enter"
Set swApp = Application.SldWorks
Set swDoc = swApp.ActiveDoc
Set swAssy = swDoc
Set swSelMgr = swDoc.SelectionManager
Const IBX As Integer = 2
Const IBY As Integer = 2
If swDoc.GetType <> swDocASSEMBLY Then
MsgBox "Use this macro in Assembly documents only.", vbCritical
Exit Sub
End If
If swSelMgr.GetSelectedObjectCount <> 2 Then
MsgBox swSelMgr.GetSelectedObjectCount & " items selected. Req'd number is 2.", vbCritical
Exit Sub
End If
CurDist = GetInitialDist
If CurDist = -1 Then
CurDist = 0
Else
CurDist = CurDist
End If
Set swMate = swAssy.AddMate3(swMateDISTANCE, swMateAlignCLOSEST, True, CurDist, CurDist, CurDist, 0, 0, 0, 0, 0, False, ErrorLong)
sMateName = swMate.Name
If Nothing Is swMate Then
MsgBox "Mating Error #" & ErrorLong & " Mate not added.", vbCritical
Exit Sub
End If
'GoTo BYPASS
If swAddMateError_OverDefinedAssembly = ErrorLong Then
MsgReply = MsgBox("Overdefining mate. Keep anyway?", vbYesNo + vbQuestion)
If vbNo = MsgReply Then
swDoc.ClearSelection2 True
swMate.Select True
swDoc.Extension.DeleteSelection2 0
Else
'swDoc.EditRebuild3
End If
ElseIf swMate.Alignment <> swMateAlignCLOSEST Then
''Verify alignment
MsgReply = MsgBox("Keep current alignment?", vbYesNo, "Mate Alignment")
If vbNo = MsgReply Then
If swMate.Alignment = swMateAlignALIGNED Then
NewAlign = swMateAlignANTI_ALIGNED
Else
NewAlign = swMateAlignALIGNED
End If
swMate.Select True
swAssy.EditMate2 swMateDISTANCE, NewAlign, False, CurDist, CurDist, CurDist, 0, 0, 0, 0, 0, ErrorLong
If swAddMateError_OverDefinedAssembly = ErrorLong Then
MsgReply = MsgBox("Flip caused errors. Undo?", vbYesNo + vbQuestion)
If vbYes = MsgReply Then
swDoc.EditUndo2 1
End If
End If
'swDoc.EditRebuild3
End If
ElseIf swAddMateError_NoError <> ErrorLong Then
MsgBox "Mate error #" & ErrorLong & vbCrLf & "Mate not added"
If Not swMate Is Nothing Then
swDoc.ClearSelection2 True
swMate.Select True
swDoc.Extension.DeleteSelection2 0
End If
ElseIf swMate.GetErrorCode <> swFeatureErrorNone Then
Select Case swMate.GetErrorCode
Case swFeatureErrorMateInvalidEdge
MsgBox "Invalid edge"
Case swFeatureErrorMateInvalidFace
MsgBox "Invalid Face"
Case swFeatureErrorMateFailedCreatingSurface
MsgBox "Mate surface type not supported"
Case swFeatureErrorMateInvalidEntity
MsgBox "Supressed, Invalid, or Missing Entity"
Case swFeatureErrorMateDanglingGeometry
MsgBox "Mate geometry is dangling"
Case swFeatureErrorMateEntityNotLinear
MsgBox "Non-linear edges cannot be used for mating"
Case swFeatureErrorMateOverdefined
MsgBox "Mate is overdefining"
Case swFeatureErrorMateIlldefined
MsgBox "Mate cannot be solved (Ill-Defined)"
Case swFeatureErrorMateBroken
MsgBox "One or more entities suppressed or invalid for this mate"
End Select
swDoc.ClearSelection2 True
swMate.Select True
swDoc.Extension.DeleteSelection2 0
End If
''''Verify/Enter Distance
'get the mate dimension - if it is nonexistent then don't mess with it.
Dim genobj As SldWorks.Feature
Set genobj = swAssy.FeatureByName(sMateName)
Set swMate = genobj.GetSpecificFeature2
Set myMateDim = swMate.DisplayDimension.GetDimension
If Not myMateDim Is Nothing Then
NewDist = Empty
CurDist = CurDist * SF
CurFlip = swMate.Flipped
InPutStr = InputBox(sMsg, "Mate Distance", CurDist, 1, 1, Empty, Empty)
If InPutStr = "" Then
NewDist = CurDist
ElseIf InPutStr = "-" Then
NewDist = -CurDist
Else
NewDist = CDbl(InPutStr)
End If
If NewDist < 0 Then
NewDist = 0 - NewDist
If False = CurFlip Then
NewFlip = True
Else
NewFlip = False
End If
Else
NewFlip = CurFlip
End If
CurDist = CDbl(CurDist)
cnt = 1
While (Abs(NewDist - CurDist) > 0.00000001) Or CurFlip <> NewFlip
'Debug.Print cnt, CurDist, CurFlip, NewDist, NewFlip
If swSelMgr.GetSelectedObjectCount <> 3 Then
'Debug.Print "select again", swSelMgr.GetSelectedObjectCount
swMate.Select True
End If
swAssy.EditMate2 swMateDISTANCE, swMate.Alignment, NewFlip, NewDist / SF, NewDist / SF, NewDist / SF, 0, 0, 0, 0, 0, ErrorLong
Set genobj = swAssy.FeatureByName(sMateName)
Set swMate = genobj.GetSpecificFeature2
Set myMateDim = swMate.DisplayDimension.GetDimension
'myMateDim.SetValue3 NewDist, swSetValue_InAllConfigurations, Empty
'swMate.Flipped = NewFlip
'swDoc.EditRebuild3
'If swAddMateError_OverDefinedAssembly = ErrorLong Then
' MsgReply = MsgBox("Distance change caused errors. Undo?", vbYesNo + vbQuestion)
' If vbYes = MsgReply Then
' swDoc.EditUndo2 1
' End If
'End If
'swDoc.EditRebuild3
CurDist = NewDist
CurFlip = swMate.Flipped
InPutStr = InputBox(sMsg, "Mate Distance", CurDist, 1, 1, Empty, Empty)
If InPutStr = "" Then
NewDist = CurDist
ElseIf InPutStr = "-" Then
NewDist = -CurDist
Else
NewDist = CDbl(InPutStr)
End If
If NewDist < 0 Then
NewDist = 0 - NewDist
If False = CurFlip Then
NewFlip = True
Else
NewFlip = False
End If
Else
NewFlip = CurFlip
End If
cnt = cnt + 1
Wend
End If
swDoc.ClearSelection2 True
Set myMateDim = Nothing
Set swApp = Nothing
Set swDoc = Nothing
Set swAssy = Nothing
Set swSelMgr = Nothing
Set swMate = Nothing
End Sub
Private Function GetInitialDist()
Dim swApp As SldWorks.SldWorks
Dim swDoc As SldWorks.ModelDoc2
Dim swSelMgr As SldWorks.SelectionMgr
Dim swMathUtil As SldWorks.MathUtility
Dim myFace As SldWorks.Face2
Dim myFirstNormVect As SldWorks.MathVector
Dim mySecondNormVect As SldWorks.MathVector
Dim myFirstXform As SldWorks.MathTransform
Dim mySecondXform As SldWorks.MathTransform
Dim myDistVect As SldWorks.MathVector
Dim myDist As Double
Dim FirstDistPoint As Variant
Dim SecondDistPoint As Variant
Dim FirstDistVect As SldWorks.MathVector
Dim myModeler As SldWorks.Modeler
Dim mySel1 As Object
Dim mySel2 As Object
Dim myCross As SldWorks.MathVector
Dim FirstSelPlanar As Boolean
Dim SecondSelPlanar As Boolean
Dim tmpArrayData(2) As Double
Dim tmpPt As SldWorks.MathPoint
Set swApp = Application.SldWorks
Set swDoc = swApp.ActiveDoc
Set swSelMgr = swDoc.SelectionManager
Set swMathUtil = swApp.GetMathUtility
'''Check the first selection
If swSelMgr.GetSelectedObjectType3(1, -1) = 4 Then 'refplanes
Set mySel1 = swSelMgr.GetSelectedObject6(1, -1).GetSpecificFeature
FirstSelPlanar = True
tmpArrayData(0) = 0
tmpArrayData(1) = 0
tmpArrayData(2) = 1
Set tmpPt = swMathUtil.CreatePoint(tmpArrayData)
Set myFirstXform = mySel1.Transform 'This gets the xfrom inside the component (not assy)
Set tmpPt = tmpPt.MultiplyTransform(myFirstXform)
Set myFirstNormVect = swMathUtil.CreateVector(tmpPt.ArrayData)
'myFirstNormVect now contains the normal vector in part coords of the selected plane
ElseIf swSelMgr.GetSelectedObjectType3(1, -1) = 2 Then 'faces
Set mySel1 = swSelMgr.GetSelectedObject6(1, -1)
Set myFirstNormVect = swMathUtil.CreateVector(mySel1.Normal)
If myFirstNormVect.GetLength <> 0 Then
FirstSelPlanar = True
Else
FirstSelPlanar = False
End If
Else
FirstSelPlanar = False
Set myFirstNormVect = Nothing
Set mySel1 = swSelMgr.GetSelectedObject6(1, -1)
End If
'''Check the second selection
If swSelMgr.GetSelectedObjectType3(2, -1) = 4 Then 'refplanes
Set mySel2 = swSelMgr.GetSelectedObject6(2, -1).GetSpecificFeature
SecondSelPlanar = True
tmpArrayData(0) = 0
tmpArrayData(1) = 0
tmpArrayData(2) = 1
Set tmpPt = swMathUtil.CreatePoint(tmpArrayData)
Set mySecondXform = mySel2.Transform 'This gets the xfrom inside the component (not assy)
Set tmpPt = tmpPt.MultiplyTransform(mySecondXform)
Set mySecondNormVect = swMathUtil.CreateVector(tmpPt.ArrayData)
'mysecondNormVect now contains the normal vector in part coords of the selected plane
ElseIf swSelMgr.GetSelectedObjectType3(2, -1) = 2 Then 'faces
Set mySel2 = swSelMgr.GetSelectedObject6(2, -1)
Set mySecondNormVect = swMathUtil.CreateVector(mySel2.Normal)
If mySecondNormVect.GetLength <> 0 Then
SecondSelPlanar = True
Else
SecondSelPlanar = False
End If
Else
SecondSelPlanar = False
Set mySecondNormVect = Nothing
Set mySel2 = swSelMgr.GetSelectedObject6(2, -1)
End If
'get the distance value and distance vector
myDist = swDoc.ClosestDistance(mySel1, mySel2, FirstDistPoint, SecondDistPoint)
Set FirstDistVect = swMathUtil.CreateVector(FirstDistPoint)
Set myDistVect = FirstDistVect.Subtract(swMathUtil.CreateVector(SecondDistPoint))
'''Now get the in-assembly transforms for each component
Set myFirstXform = swSelMgr.GetSelectedObjectsComponent3(1, -1).GetTotalTransform(True)
Set mySecondXform = swSelMgr.GetSelectedObjectsComponent3(2, -1).GetTotalTransform(True)
If FirstSelPlanar And SecondSelPlanar Then
Set myFirstNormVect = myFirstNormVect.MultiplyTransform(myFirstXform)
Set mySecondNormVect = mySecondNormVect.MultiplyTransform(mySecondXform)
Set myCross = myFirstNormVect.Cross(mySecondNormVect)
If myCross.GetLength < 0.000000001 Then 'assume planes are parallel. Use par. dist
myDist = Abs(myDistVect.Dot(myFirstNormVect.Normalise))
Else
'Leave myDist as-is
End If
ElseIf FirstSelPlanar Then
'Debug.Print "first planar"
myDist = Abs(myDistVect.Dot(myFirstNormVect.Normalise))
ElseIf SecondSelPlanar Then
'Debug.Print "second planar"
myDist = Abs(myDistVect.Dot(mySecondNormVect.Normalise))
End If
'MsgBox myDist * SF
GetInitialDist = myDist
Set swApp = Nothing
Set swDoc = Nothing
Set swSelMgr = Nothing
Set swMathUtil = Nothing
Set myFace = Nothing
Set myFirstNormVect = Nothing
Set mySecondNormVect = Nothing
Set myFirstXform = Nothing
Set mySecondXform = Nothing
Set myDistVect = Nothing
Set FirstDistVect = Nothing
Set mySel1 = Nothing
Set mySel2 = Nothing
Set myCross = Nothing
Set tmpPt = Nothing
End Function
'Change the scale factor value above based on your
'standard unit system. Use:
'1000 for mm
'100/2.54 for inches
Sub main()
Dim CurDist As Double
Dim NewDist As Double
Dim CurFlip As Boolean
Dim NewFlip As Boolean
Dim cnt As Long
Dim myMateDim As SldWorks.Dimension
Dim InPutStr As String
Dim swApp As SldWorks.SldWorks
Dim swDoc As SldWorks.ModelDoc2
Dim swAssy As SldWorks.AssemblyDoc
Dim swSelMgr As SldWorks.SelectionMgr
Dim swMate As SldWorks.Mate2
Dim ErrorLong As Long
Dim MsgReply As Integer
Dim NewAlign As Long
Dim sMsg As String
Dim sMateName As String
sMsg = "Enter desired mate distance" & vbCrLf & _
"Enter a negative number to flip the dimension and change value." & vbCrLf & _
"Enter ""-"" alone to flip current value shown" & _
"To accept the current value, Cancel or press Enter"
Set swApp = Application.SldWorks
Set swDoc = swApp.ActiveDoc
Set swAssy = swDoc
Set swSelMgr = swDoc.SelectionManager
Const IBX As Integer = 2
Const IBY As Integer = 2
If swDoc.GetType <> swDocASSEMBLY Then
MsgBox "Use this macro in Assembly documents only.", vbCritical
Exit Sub
End If
If swSelMgr.GetSelectedObjectCount <> 2 Then
MsgBox swSelMgr.GetSelectedObjectCount & " items selected. Req'd number is 2.", vbCritical
Exit Sub
End If
CurDist = GetInitialDist
If CurDist = -1 Then
CurDist = 0
Else
CurDist = CurDist
End If
Set swMate = swAssy.AddMate3(swMateDISTANCE, swMateAlignCLOSEST, True, CurDist, CurDist, CurDist, 0, 0, 0, 0, 0, False, ErrorLong)
sMateName = swMate.Name
If Nothing Is swMate Then
MsgBox "Mating Error #" & ErrorLong & " Mate not added.", vbCritical
Exit Sub
End If
'GoTo BYPASS
If swAddMateError_OverDefinedAssembly = ErrorLong Then
MsgReply = MsgBox("Overdefining mate. Keep anyway?", vbYesNo + vbQuestion)
If vbNo = MsgReply Then
swDoc.ClearSelection2 True
swMate.Select True
swDoc.Extension.DeleteSelection2 0
Else
'swDoc.EditRebuild3
End If
ElseIf swMate.Alignment <> swMateAlignCLOSEST Then
''Verify alignment
MsgReply = MsgBox("Keep current alignment?", vbYesNo, "Mate Alignment")
If vbNo = MsgReply Then
If swMate.Alignment = swMateAlignALIGNED Then
NewAlign = swMateAlignANTI_ALIGNED
Else
NewAlign = swMateAlignALIGNED
End If
swMate.Select True
swAssy.EditMate2 swMateDISTANCE, NewAlign, False, CurDist, CurDist, CurDist, 0, 0, 0, 0, 0, ErrorLong
If swAddMateError_OverDefinedAssembly = ErrorLong Then
MsgReply = MsgBox("Flip caused errors. Undo?", vbYesNo + vbQuestion)
If vbYes = MsgReply Then
swDoc.EditUndo2 1
End If
End If
'swDoc.EditRebuild3
End If
ElseIf swAddMateError_NoError <> ErrorLong Then
MsgBox "Mate error #" & ErrorLong & vbCrLf & "Mate not added"
If Not swMate Is Nothing Then
swDoc.ClearSelection2 True
swMate.Select True
swDoc.Extension.DeleteSelection2 0
End If
ElseIf swMate.GetErrorCode <> swFeatureErrorNone Then
Select Case swMate.GetErrorCode
Case swFeatureErrorMateInvalidEdge
MsgBox "Invalid edge"
Case swFeatureErrorMateInvalidFace
MsgBox "Invalid Face"
Case swFeatureErrorMateFailedCreatingSurface
MsgBox "Mate surface type not supported"
Case swFeatureErrorMateInvalidEntity
MsgBox "Supressed, Invalid, or Missing Entity"
Case swFeatureErrorMateDanglingGeometry
MsgBox "Mate geometry is dangling"
Case swFeatureErrorMateEntityNotLinear
MsgBox "Non-linear edges cannot be used for mating"
Case swFeatureErrorMateOverdefined
MsgBox "Mate is overdefining"
Case swFeatureErrorMateIlldefined
MsgBox "Mate cannot be solved (Ill-Defined)"
Case swFeatureErrorMateBroken
MsgBox "One or more entities suppressed or invalid for this mate"
End Select
swDoc.ClearSelection2 True
swMate.Select True
swDoc.Extension.DeleteSelection2 0
End If
''''Verify/Enter Distance
'get the mate dimension - if it is nonexistent then don't mess with it.
Dim genobj As SldWorks.Feature
Set genobj = swAssy.FeatureByName(sMateName)
Set swMate = genobj.GetSpecificFeature2
Set myMateDim = swMate.DisplayDimension.GetDimension
If Not myMateDim Is Nothing Then
NewDist = Empty
CurDist = CurDist * SF
CurFlip = swMate.Flipped
InPutStr = InputBox(sMsg, "Mate Distance", CurDist, 1, 1, Empty, Empty)
If InPutStr = "" Then
NewDist = CurDist
ElseIf InPutStr = "-" Then
NewDist = -CurDist
Else
NewDist = CDbl(InPutStr)
End If
If NewDist < 0 Then
NewDist = 0 - NewDist
If False = CurFlip Then
NewFlip = True
Else
NewFlip = False
End If
Else
NewFlip = CurFlip
End If
CurDist = CDbl(CurDist)
cnt = 1
While (Abs(NewDist - CurDist) > 0.00000001) Or CurFlip <> NewFlip
'Debug.Print cnt, CurDist, CurFlip, NewDist, NewFlip
If swSelMgr.GetSelectedObjectCount <> 3 Then
'Debug.Print "select again", swSelMgr.GetSelectedObjectCount
swMate.Select True
End If
swAssy.EditMate2 swMateDISTANCE, swMate.Alignment, NewFlip, NewDist / SF, NewDist / SF, NewDist / SF, 0, 0, 0, 0, 0, ErrorLong
Set genobj = swAssy.FeatureByName(sMateName)
Set swMate = genobj.GetSpecificFeature2
Set myMateDim = swMate.DisplayDimension.GetDimension
'myMateDim.SetValue3 NewDist, swSetValue_InAllConfigurations, Empty
'swMate.Flipped = NewFlip
'swDoc.EditRebuild3
'If swAddMateError_OverDefinedAssembly = ErrorLong Then
' MsgReply = MsgBox("Distance change caused errors. Undo?", vbYesNo + vbQuestion)
' If vbYes = MsgReply Then
' swDoc.EditUndo2 1
' End If
'End If
'swDoc.EditRebuild3
CurDist = NewDist
CurFlip = swMate.Flipped
InPutStr = InputBox(sMsg, "Mate Distance", CurDist, 1, 1, Empty, Empty)
If InPutStr = "" Then
NewDist = CurDist
ElseIf InPutStr = "-" Then
NewDist = -CurDist
Else
NewDist = CDbl(InPutStr)
End If
If NewDist < 0 Then
NewDist = 0 - NewDist
If False = CurFlip Then
NewFlip = True
Else
NewFlip = False
End If
Else
NewFlip = CurFlip
End If
cnt = cnt + 1
Wend
End If
swDoc.ClearSelection2 True
Set myMateDim = Nothing
Set swApp = Nothing
Set swDoc = Nothing
Set swAssy = Nothing
Set swSelMgr = Nothing
Set swMate = Nothing
End Sub
Private Function GetInitialDist()
Dim swApp As SldWorks.SldWorks
Dim swDoc As SldWorks.ModelDoc2
Dim swSelMgr As SldWorks.SelectionMgr
Dim swMathUtil As SldWorks.MathUtility
Dim myFace As SldWorks.Face2
Dim myFirstNormVect As SldWorks.MathVector
Dim mySecondNormVect As SldWorks.MathVector
Dim myFirstXform As SldWorks.MathTransform
Dim mySecondXform As SldWorks.MathTransform
Dim myDistVect As SldWorks.MathVector
Dim myDist As Double
Dim FirstDistPoint As Variant
Dim SecondDistPoint As Variant
Dim FirstDistVect As SldWorks.MathVector
Dim myModeler As SldWorks.Modeler
Dim mySel1 As Object
Dim mySel2 As Object
Dim myCross As SldWorks.MathVector
Dim FirstSelPlanar As Boolean
Dim SecondSelPlanar As Boolean
Dim tmpArrayData(2) As Double
Dim tmpPt As SldWorks.MathPoint
Set swApp = Application.SldWorks
Set swDoc = swApp.ActiveDoc
Set swSelMgr = swDoc.SelectionManager
Set swMathUtil = swApp.GetMathUtility
'''Check the first selection
If swSelMgr.GetSelectedObjectType3(1, -1) = 4 Then 'refplanes
Set mySel1 = swSelMgr.GetSelectedObject6(1, -1).GetSpecificFeature
FirstSelPlanar = True
tmpArrayData(0) = 0
tmpArrayData(1) = 0
tmpArrayData(2) = 1
Set tmpPt = swMathUtil.CreatePoint(tmpArrayData)
Set myFirstXform = mySel1.Transform 'This gets the xfrom inside the component (not assy)
Set tmpPt = tmpPt.MultiplyTransform(myFirstXform)
Set myFirstNormVect = swMathUtil.CreateVector(tmpPt.ArrayData)
'myFirstNormVect now contains the normal vector in part coords of the selected plane
ElseIf swSelMgr.GetSelectedObjectType3(1, -1) = 2 Then 'faces
Set mySel1 = swSelMgr.GetSelectedObject6(1, -1)
Set myFirstNormVect = swMathUtil.CreateVector(mySel1.Normal)
If myFirstNormVect.GetLength <> 0 Then
FirstSelPlanar = True
Else
FirstSelPlanar = False
End If
Else
FirstSelPlanar = False
Set myFirstNormVect = Nothing
Set mySel1 = swSelMgr.GetSelectedObject6(1, -1)
End If
'''Check the second selection
If swSelMgr.GetSelectedObjectType3(2, -1) = 4 Then 'refplanes
Set mySel2 = swSelMgr.GetSelectedObject6(2, -1).GetSpecificFeature
SecondSelPlanar = True
tmpArrayData(0) = 0
tmpArrayData(1) = 0
tmpArrayData(2) = 1
Set tmpPt = swMathUtil.CreatePoint(tmpArrayData)
Set mySecondXform = mySel2.Transform 'This gets the xfrom inside the component (not assy)
Set tmpPt = tmpPt.MultiplyTransform(mySecondXform)
Set mySecondNormVect = swMathUtil.CreateVector(tmpPt.ArrayData)
'mysecondNormVect now contains the normal vector in part coords of the selected plane
ElseIf swSelMgr.GetSelectedObjectType3(2, -1) = 2 Then 'faces
Set mySel2 = swSelMgr.GetSelectedObject6(2, -1)
Set mySecondNormVect = swMathUtil.CreateVector(mySel2.Normal)
If mySecondNormVect.GetLength <> 0 Then
SecondSelPlanar = True
Else
SecondSelPlanar = False
End If
Else
SecondSelPlanar = False
Set mySecondNormVect = Nothing
Set mySel2 = swSelMgr.GetSelectedObject6(2, -1)
End If
'get the distance value and distance vector
myDist = swDoc.ClosestDistance(mySel1, mySel2, FirstDistPoint, SecondDistPoint)
Set FirstDistVect = swMathUtil.CreateVector(FirstDistPoint)
Set myDistVect = FirstDistVect.Subtract(swMathUtil.CreateVector(SecondDistPoint))
'''Now get the in-assembly transforms for each component
Set myFirstXform = swSelMgr.GetSelectedObjectsComponent3(1, -1).GetTotalTransform(True)
Set mySecondXform = swSelMgr.GetSelectedObjectsComponent3(2, -1).GetTotalTransform(True)
If FirstSelPlanar And SecondSelPlanar Then
Set myFirstNormVect = myFirstNormVect.MultiplyTransform(myFirstXform)
Set mySecondNormVect = mySecondNormVect.MultiplyTransform(mySecondXform)
Set myCross = myFirstNormVect.Cross(mySecondNormVect)
If myCross.GetLength < 0.000000001 Then 'assume planes are parallel. Use par. dist
myDist = Abs(myDistVect.Dot(myFirstNormVect.Normalise))
Else
'Leave myDist as-is
End If
ElseIf FirstSelPlanar Then
'Debug.Print "first planar"
myDist = Abs(myDistVect.Dot(myFirstNormVect.Normalise))
ElseIf SecondSelPlanar Then
'Debug.Print "second planar"
myDist = Abs(myDistVect.Dot(mySecondNormVect.Normalise))
End If
'MsgBox myDist * SF
GetInitialDist = myDist
Set swApp = Nothing
Set swDoc = Nothing
Set swSelMgr = Nothing
Set swMathUtil = Nothing
Set myFace = Nothing
Set myFirstNormVect = Nothing
Set mySecondNormVect = Nothing
Set myFirstXform = Nothing
Set mySecondXform = Nothing
Set myDistVect = Nothing
Set FirstDistVect = Nothing
Set mySel1 = Nothing
Set mySel2 = Nothing
Set myCross = Nothing
Set tmpPt = Nothing
End Function






RE: Distance Mate Macro
RE: Distance Mate Macro
I think it's all fixed now... It looks rather long, but it still runs fast.
CODE
'Change the scale factor value above based on your
'standard unit system. Use:
'1000 for mm
'100/2.54 for inches
Sub main()
Dim CurDist As Double
Dim NewDist As Double
Dim CurFlip As Boolean
Dim NewFlip As Boolean
Dim cnt As Long
Dim myMateDim As SldWorks.Dimension
Dim InPutStr As String
Dim swApp As SldWorks.SldWorks
Dim swDoc As SldWorks.ModelDoc2
Dim swAssy As SldWorks.AssemblyDoc
Dim swSelMgr As SldWorks.SelectionMgr
Dim swMate As SldWorks.Mate2
Dim ErrorLong As Long
Dim MsgReply As Integer
Dim NewAlign As Long
Dim sMsg As String
Dim sMateName As String
Dim comp1Xform As SldWorks.MathTransform
Dim comp2Xform As SldWorks.MathTransform
Dim preMateVec1 As SldWorks.MathVector
Dim preMateVec2 As SldWorks.MathVector
Dim postMateVec1 As SldWorks.MathVector
Dim postMateVec2 As SldWorks.MathVector
Dim tVar As Variant
Dim Cross1Len As Double
Dim Cross2Len As Double
Dim UnFlippedCrossSum As Double
Dim FlippedCrossSum As Double
Dim genobj As SldWorks.Feature
sMsg = "Enter desired mate distance" & vbCrLf & _
"Enter a negative number to flip the dimension and change value." & vbCrLf & _
"Enter ""-"" alone to flip current value shown" & _
"To accept the current value, Cancel or press Enter"
Set swApp = Application.SldWorks
Set swDoc = swApp.ActiveDoc
Set swAssy = swDoc
Set swSelMgr = swDoc.SelectionManager
Const IBX As Integer = 2
Const IBY As Integer = 2
If swDoc.GetType <> swDocASSEMBLY Then
MsgBox "Use this macro in Assembly documents only.", vbCritical
Exit Sub
End If
If swSelMgr.GetSelectedObjectCount <> 2 Then
MsgBox swSelMgr.GetSelectedObjectCount & " items selected. Req'd number is 2.", vbCritical
Exit Sub
End If
CurDist = GetInitialDist(comp1Xform, comp2Xform)
If CurDist = -1 Then
CurDist = 0
Else
CurDist = CurDist
End If
If Not comp1Xform Is Nothing Then comp1Xform.GetData Nothing, Nothing, Nothing, preMateVec1, Empty
If Not comp2Xform Is Nothing Then comp2Xform.GetData Nothing, Nothing, Nothing, preMateVec2, Empty
Set swMate = swAssy.AddMate3(swMateDISTANCE, swMateAlignCLOSEST, False, CurDist, CurDist, CurDist, 0, 0, 0, 0, 0, False, ErrorLong)
If Nothing Is swMate Then
MsgBox "Mating Error #" & ErrorLong & " Mate not added.", vbCritical
Exit Sub
End If
sMateName = swMate.Name
'get the post-mate transforms of each component
If Not swSelMgr.GetSelectedObjectsComponent3(1, -1) Is Nothing Then
Set comp1Xform = swSelMgr.GetSelectedObjectsComponent3(1, -1).GetTotalTransform(True)
comp1Xform.GetData Nothing, Nothing, Nothing, postMateVec1, Empty
End If
If Not swSelMgr.GetSelectedObjectsComponent3(2, -1) Is Nothing Then
Set comp2Xform = swSelMgr.GetSelectedObjectsComponent3(2, -1).GetTotalTransform(True)
comp2Xform.GetData Nothing, Nothing, Nothing, postMateVec2, Empty
End If
'Get the sum of the magnitudes of the cross products of the vectors pre-and post-mate.
'If the pre-mate and post-mate vectors (from assy origin to component) are close to the
'same angle, their cross-product will be minimal. The idea is to take the length of
'the pre- and post-mate cross products for both components for flipped and un-flipped.
'the minimum of these two is most likely the closest to the original location.
If (Not preMateVec1 Is Nothing) And (Not postMateVec1 Is Nothing) Then
Cross1Len = preMateVec1.Cross(postMateVec1).GetLength
Else
Cross1Len = 0
End If
If (Not preMateVec2 Is Nothing) And (Not postMateVec2 Is Nothing) Then
Cross2Len = preMateVec2.Cross(postMateVec2).GetLength
Else
Cross2Len = 0
End If
UnFlippedCrossSum = Cross1Len + Cross2Len
'swMate.Flipped = True
If swSelMgr.GetSelectedObjectCount <> 3 Then
'Debug.Print "select again", swSelMgr.GetSelectedObjectCount
swMate.Select True
End If
swAssy.EditMate2 swMateDISTANCE, swMate.Alignment, True, CurDist, CurDist, CurDist, 0, 0, 0, 0, 0, ErrorLong
Set genobj = swAssy.FeatureByName(sMateName)
Set swMate = genobj.GetSpecificFeature2
If Not swSelMgr.GetSelectedObjectsComponent3(1, -1) Is Nothing Then
Set comp1Xform = swSelMgr.GetSelectedObjectsComponent3(1, -1).GetTotalTransform(True)
comp1Xform.GetData Nothing, Nothing, Nothing, postMateVec1, Empty
End If
If Not swSelMgr.GetSelectedObjectsComponent3(2, -1) Is Nothing Then
Set comp2Xform = swSelMgr.GetSelectedObjectsComponent3(2, -1).GetTotalTransform(True)
comp2Xform.GetData Nothing, Nothing, Nothing, postMateVec2, Empty
End If
If (Not preMateVec1 Is Nothing) And (Not postMateVec1 Is Nothing) Then
Cross1Len = preMateVec1.Cross(postMateVec1).GetLength
Else
Cross1Len = 0
End If
If (Not preMateVec2 Is Nothing) And (Not postMateVec2 Is Nothing) Then
Cross2Len = preMateVec2.Cross(postMateVec2).GetLength
Else
Cross2Len = 0
End If
FlippedCrossSum = Cross1Len + Cross2Len
'Debug.Print UnFlippedCrossSum, FlippedCrossSum
If UnFlippedCrossSum < FlippedCrossSum Then
If swSelMgr.GetSelectedObjectCount <> 3 Then
'Debug.Print "select again", swSelMgr.GetSelectedObjectCount
swMate.Select True
End If
swAssy.EditMate2 swMateDISTANCE, swMate.Alignment, False, CurDist, CurDist, CurDist, 0, 0, 0, 0, 0, ErrorLong
Set genobj = swAssy.FeatureByName(sMateName)
Set swMate = genobj.GetSpecificFeature2
End If
'GoTo BYPASS
If swAddMateError_OverDefinedAssembly = ErrorLong Then
MsgReply = MsgBox("Overdefining mate. Keep anyway?", vbYesNo + vbQuestion)
If vbNo = MsgReply Then
swDoc.ClearSelection2 True
swMate.Select True
swDoc.Extension.DeleteSelection2 0
Else
'swDoc.EditRebuild3
End If
ElseIf swMate.Alignment <> swMateAlignCLOSEST Then
'''Verify alignment
MsgReply = MsgBox("Keep current alignment?", vbYesNo, "Mate Alignment")
If vbNo = MsgReply Then
If swMate.Alignment = swMateAlignALIGNED Then
NewAlign = swMateAlignANTI_ALIGNED
Else
NewAlign = swMateAlignALIGNED
End If
swMate.Select True
swAssy.EditMate2 swMateDISTANCE, NewAlign, False, CurDist, CurDist, CurDist, 0, 0, 0, 0, 0, ErrorLong
If swAddMateError_OverDefinedAssembly = ErrorLong Then
MsgReply = MsgBox("Flip caused errors. Undo?", vbYesNo + vbQuestion)
If vbYes = MsgReply Then
swDoc.EditUndo2 1
End If
End If
'swDoc.EditRebuild3
End If
ElseIf swAddMateError_NoError <> ErrorLong Then
MsgBox "Mate error #" & ErrorLong & vbCrLf & "Mate not added"
If Not swMate Is Nothing Then
swDoc.ClearSelection2 True
swMate.Select True
swDoc.Extension.DeleteSelection2 0
End If
ElseIf swMate.GetErrorCode <> swFeatureErrorNone Then
Select Case swMate.GetErrorCode
Case swFeatureErrorMateInvalidEdge
MsgBox "Invalid edge"
Case swFeatureErrorMateInvalidFace
MsgBox "Invalid Face"
Case swFeatureErrorMateFailedCreatingSurface
MsgBox "Mate surface type not supported"
Case swFeatureErrorMateInvalidEntity
MsgBox "Supressed, Invalid, or Missing Entity"
Case swFeatureErrorMateDanglingGeometry
MsgBox "Mate geometry is dangling"
Case swFeatureErrorMateEntityNotLinear
MsgBox "Non-linear edges cannot be used for mating"
Case swFeatureErrorMateOverdefined
MsgBox "Mate is overdefining"
Case swFeatureErrorMateIlldefined
MsgBox "Mate cannot be solved (Ill-Defined)"
Case swFeatureErrorMateBroken
MsgBox "One or more entities suppressed or invalid for this mate"
End Select
swDoc.ClearSelection2 True
swMate.Select True
swDoc.Extension.DeleteSelection2 0
End If
''''''''Verify/Enter Distance
'get the mate dimension - if it is nonexistent then don't mess with it.
Set genobj = swAssy.FeatureByName(sMateName)
If Not genobj Is Nothing Then
Set swMate = genobj.GetSpecificFeature2
Set myMateDim = swMate.DisplayDimension.GetDimension
NewDist = Empty
CurDist = CurDist * SF
CurFlip = swMate.Flipped
InPutStr = InputBox(sMsg, "Mate Distance", CurDist, 1, 1, Empty, Empty)
If InPutStr = "" Then
NewDist = CurDist
ElseIf InPutStr = "-" Then
NewDist = -CurDist
Else
NewDist = CDbl(InPutStr)
End If
If NewDist < 0 Then
NewDist = 0 - NewDist
If False = CurFlip Then
NewFlip = True
Else
NewFlip = False
End If
Else
NewFlip = CurFlip
End If
CurDist = CDbl(CurDist)
cnt = 1
While (Abs(NewDist - CurDist) > 0.00000001) Or CurFlip <> NewFlip
'Debug.Print cnt, CurDist, CurFlip, NewDist, NewFlip
If swSelMgr.GetSelectedObjectCount <> 3 Then
'Debug.Print "select again", swSelMgr.GetSelectedObjectCount
swMate.Select True
End If
swAssy.EditMate2 swMateDISTANCE, swMate.Alignment, NewFlip, NewDist / SF, NewDist / SF, NewDist / SF, 0, 0, 0, 0, 0, ErrorLong
Set genobj = swAssy.FeatureByName(sMateName)
Set swMate = genobj.GetSpecificFeature2
Set myMateDim = swMate.DisplayDimension.GetDimension
'myMateDim.SetValue3 NewDist, swSetValue_InAllConfigurations, Empty
'swMate.Flipped = NewFlip
'swDoc.EditRebuild3
'If swAddMateError_OverDefinedAssembly = ErrorLong Then
' MsgReply = MsgBox("Distance change caused errors. Undo?", vbYesNo + vbQuestion)
' If vbYes = MsgReply Then
' swDoc.EditUndo2 1
' End If
'End If
'swDoc.EditRebuild3
CurDist = NewDist
CurFlip = swMate.Flipped
InPutStr = InputBox(sMsg, "Mate Distance", CurDist, 1, 1, Empty, Empty)
If InPutStr = "" Then
NewDist = CurDist
ElseIf InPutStr = "-" Then
NewDist = -CurDist
Else
NewDist = CDbl(InPutStr)
End If
If NewDist < 0 Then
NewDist = 0 - NewDist
If False = CurFlip Then
NewFlip = True
Else
NewFlip = False
End If
Else
NewFlip = CurFlip
End If
cnt = cnt + 1
Wend
End If
swDoc.ClearSelection2 True
Set myMateDim = Nothing
Set swApp = Nothing
Set swDoc = Nothing
Set swAssy = Nothing
Set swSelMgr = Nothing
Set swMate = Nothing
End Sub
Private Function GetInitialDist(ByRef c1Xform As SldWorks.MathTransform, ByRef c2Xform As SldWorks.MathTransform)
Dim swApp As SldWorks.SldWorks
Dim swDoc As SldWorks.ModelDoc2
Dim swSelMgr As SldWorks.SelectionMgr
Dim swMathUtil As SldWorks.MathUtility
Dim myFace As SldWorks.Face2
Dim myFirstNormVect As SldWorks.MathVector
Dim mySecondNormVect As SldWorks.MathVector
Dim myFirstXform As SldWorks.MathTransform
Dim mySecondXform As SldWorks.MathTransform
Dim myDistVect As SldWorks.MathVector
Dim myDist As Double
Dim FirstDistPoint As Variant
Dim SecondDistPoint As Variant
Dim FirstDistVect As SldWorks.MathVector
Dim myModeler As SldWorks.Modeler
Dim mySel1 As Object
Dim mySel2 As Object
Dim myCross As SldWorks.MathVector
Dim FirstSelPlanar As Boolean
Dim SecondSelPlanar As Boolean
Dim tmpArrayData(2) As Double
Dim tmpPt As SldWorks.MathPoint
Set swApp = Application.SldWorks
Set swDoc = swApp.ActiveDoc
Set swSelMgr = swDoc.SelectionManager
Set swMathUtil = swApp.GetMathUtility
''''''Check the first selection
If swSelMgr.GetSelectedObjectType3(1, -1) = 4 Then 'refplanes
Set mySel1 = swSelMgr.GetSelectedObject6(1, -1).GetSpecificFeature
FirstSelPlanar = True
tmpArrayData(0) = 0
tmpArrayData(1) = 0
tmpArrayData(2) = 1
Set tmpPt = swMathUtil.CreatePoint(tmpArrayData)
Set myFirstXform = mySel1.Transform 'This gets the xfrom inside the component (not assy)
Set tmpPt = tmpPt.MultiplyTransform(myFirstXform)
Set myFirstNormVect = swMathUtil.CreateVector(tmpPt.ArrayData)
'myFirstNormVect now contains the normal vector in part coords of the selected plane
ElseIf swSelMgr.GetSelectedObjectType3(1, -1) = 2 Then 'faces
Set mySel1 = swSelMgr.GetSelectedObject6(1, -1)
Set myFirstNormVect = swMathUtil.CreateVector(mySel1.Normal)
If myFirstNormVect.GetLength <> 0 Then
FirstSelPlanar = True
Else
FirstSelPlanar = False
End If
Else
FirstSelPlanar = False
Set myFirstNormVect = Nothing
Set mySel1 = swSelMgr.GetSelectedObject6(1, -1)
End If
'''''Check the second selection
If swSelMgr.GetSelectedObjectType3(2, -1) = 4 Then 'refplanes
Set mySel2 = swSelMgr.GetSelectedObject6(2, -1).GetSpecificFeature
SecondSelPlanar = True
tmpArrayData(0) = 0
tmpArrayData(1) = 0
tmpArrayData(2) = 1
Set tmpPt = swMathUtil.CreatePoint(tmpArrayData)
Set mySecondXform = mySel2.Transform 'This gets the xfrom inside the component (not assy)
Set tmpPt = tmpPt.MultiplyTransform(mySecondXform)
Set mySecondNormVect = swMathUtil.CreateVector(tmpPt.ArrayData)
'mysecondNormVect now contains the normal vector in part coords of the selected plane
ElseIf swSelMgr.GetSelectedObjectType3(2, -1) = 2 Then 'faces
Set mySel2 = swSelMgr.GetSelectedObject6(2, -1)
Set mySecondNormVect = swMathUtil.CreateVector(mySel2.Normal)
If mySecondNormVect.GetLength <> 0 Then
SecondSelPlanar = True
Else
SecondSelPlanar = False
End If
Else
SecondSelPlanar = False
Set mySecondNormVect = Nothing
Set mySel2 = swSelMgr.GetSelectedObject6(2, -1)
End If
'get the distance value and distance vector
myDist = swDoc.ClosestDistance(mySel1, mySel2, FirstDistPoint, SecondDistPoint)
Set FirstDistVect = swMathUtil.CreateVector(FirstDistPoint)
Set myDistVect = FirstDistVect.Subtract(swMathUtil.CreateVector(SecondDistPoint))
''''''Now get the in-assembly transforms for each component
Dim i As Long
Debug.Print "rotation"
For i = 0 To 2
'Debug.Print myFirstXform.ArrayData(3 * i), myFirstXform.ArrayData(3 * i + 1), myFirstXform.ArrayData(3 * i + 2)
Next i
Debug.Print "xlation"
i = 3
'Debug.Print myFirstXform.ArrayData(3 * i), myFirstXform.ArrayData(3 * i + 1), myFirstXform.ArrayData(3 * i + 2)
If Not swSelMgr.GetSelectedObjectsComponent3(1, -1) Is Nothing Then
Set myFirstXform = swSelMgr.GetSelectedObjectsComponent3(1, -1).GetTotalTransform(True)
Set c1Xform = myFirstXform
ElseIf Not myFirstXform Is Nothing Then
Set c1Xform = myFirstXform
End If
If Not swSelMgr.GetSelectedObjectsComponent3(2, -1) Is Nothing Then
Set mySecondXform = swSelMgr.GetSelectedObjectsComponent3(2, -1).GetTotalTransform(True)
Set c2Xform = mySecondXform
ElseIf Not mySecondXform Is Nothing Then
Set c2Xform = mySecondXform
End If
If FirstSelPlanar And SecondSelPlanar Then
Set myFirstNormVect = myFirstNormVect.MultiplyTransform(myFirstXform)
Set mySecondNormVect = mySecondNormVect.MultiplyTransform(mySecondXform)
Set myCross = myFirstNormVect.Cross(mySecondNormVect)
If myCross.GetLength < 0.000000001 Then 'assume planes are parallel. Use par. dist
myDist = Abs(myDistVect.Dot(myFirstNormVect.Normalise))
Else
'Leave myDist as-is
End If
ElseIf FirstSelPlanar Then
'Debug.Print "first planar"
myDist = Abs(myDistVect.Dot(myFirstNormVect.Normalise))
ElseIf SecondSelPlanar Then
'Debug.Print "second planar"
myDist = Abs(myDistVect.Dot(mySecondNormVect.Normalise))
End If
'MsgBox myDist * sf
GetInitialDist = myDist
Set swApp = Nothing
Set swDoc = Nothing
Set swSelMgr = Nothing
Set swMathUtil = Nothing
Set myFace = Nothing
Set myFirstNormVect = Nothing
Set mySecondNormVect = Nothing
Set myFirstXform = Nothing
Set mySecondXform = Nothing
Set myDistVect = Nothing
Set FirstDistVect = Nothing
Set mySel1 = Nothing
Set mySel2 = Nothing
Set myCross = Nothing
Set tmpPt = Nothing
End Function
RE: Distance Mate Macro
It works great, but just one small point. After creating the mate, you have to rebuild the assembly to have it show in the FM.
RE: Distance Mate Macro
0.016s for no rebuild (current function - mates don't show up in tree)
0.332s for FeatureManager::UpdateFeatureTree (tree updates, but no geom. rebuilding)
0.379s for ModelDoc2::Rebuild with the swUpdateMates option (mates added to tree, mate geom. rebuilt if needed)
0.863s for EditRebuild3 (full, non-Ctrl-Q, rebuild)
0.86 seconds was unacceptable to me, but 0.332 is probably reasonable.
The way the rest of the macro works, UpdateFeatureTree would probably be all that is needed. If you want to add that in, just put the line
swDoc.FeatureManager.UpdateFeatureTree
at the end of the main() subroutine, right after the line "swDoc.ClearSelection2 True" and immediately before all of the "Set Xxxx = Nothing" lines. If you use the other three macros and want to add that line to those, it would also go right at the end just after the "swDoc.ClearSelection2 True" line.
RE: Distance Mate Macro
Matt
CAD Engineer/ECN Analyst
Silicon Valley, CA
sw.fcsuper.com
Co-moderator of Solidworks Yahoo! Group
RE: Distance Mate Macro
There are two places in the macro where the line:
NewDist = CDbl(InPutStr)
occurs. I was using the macro and (unthinkingly) tried to enter a mathematical expression rather than a straight number. Obviously, that failed. But I found the undocumented function "Evaluate". From what I can gather, it evaluates its argument as though it were a line of VBA code. Long story short, replace the line above with
NewDist = CDbl(Evaluate(InPutStr, True, False))
and you can enter any expression that is evaluatable in VBA. 362-69, 20+cos(1.970), whatever you want that can be evaluated to a number.
RE: Distance Mate Macro
CODE
SF = 1000 'scale factor: meters -to- mm
ElseIf (swDoc.GetUserPreferenceIntegerValue(swUnitsLinear) = swINCHES) Then
SF = 1000 / 25.4 'scale factor: meters -to- inches
Else
MsgBox "Use this macro for Assembly documents with mm or inch units only.", vbCritical, "Distance Mate Macro"
Exit Sub
End If
RE: Distance Mate Macro
CODE
InPutStr = Replace(InPutStr, "'", "*" & SF / (100 / 30.48), 1, -1, vbTextCompare)
InPutStr = Replace(InPutStr, "mm", "*" & SF / 1000, 1, -1, vbTextCompare)
InPutStr = Replace(InPutStr, "cm", "*" & SF / 100, 1, -1, vbTextCompare)
InPutStr = Replace(InPutStr, "m", "*" & SF, 1, -1, vbTextCompare)
immediately above the two lines with "Evaluate" then you can enter values in designated units, regardless of your current document units setting, as long as you either set up the SF constant correctly or add Ken's code above (Thanks, Ken!). Any number without a unit designation will be evaluated per the SF constant.
For example, if you have the SF set for mm and you enter
60+1"
you will get a distance mate of 85.4mm. However, it's not fixed up for compound fractions, so if you want to put in 1.25" in fractions, you would have to enter the plus sign, like 1"+1/4" rather than 1 1/4". Note that both terms have the quotes for inches. If you entered just 1+1/4", you would end up with 1mm+1/4" if you're set up for mm. If you're set up with inches for the SF, 1+1/4 will just get you 1.25" as expected.
Obviously, it's currently set up to convert inches, feet, mm, cm, and m, but if you need some other unit it's a pretty simple matter to add another Replace line.
RE: Distance Mate Macro
Thanks.
Sylvia
RE: Distance Mate Macro
RE: Distance Mate Macro
Thanks for sharing. That must have taken a fair bit of your time to produce.
RE: Distance Mate Macro
I tried the distance mate macro from the book "Automating Solidworks 2006 using MACROS" but it was metric and wasn't as easy to use as this one is.
RE: Distance Mate Macro
The initial one worked with 2007, but the new one doesn't. How did you reset the references? Thanks.
Also thanks to the guys that created this.
Sylvia
RE: Distance Mate Macro
RE: Distance Mate Macro
Open the macro with the Edit macro tool, then in Tools > References deselect the 2008 refs and select the corresponding 2007 refs. Then close and save the macro.
RE: Distance Mate Macro