Hi,
The code pasted below is to get the length and width of a part andI have been having alot of trouble with it and was wondering ifsomebody could help me with it.
I have been playing with this code for quite some time now and justcannot figure out what is wrong. It errors out at "Set SwConfig =swConfigMgr.ActiveConfiguration" and also with the math utility. Ifound this code on this site but it was not complete so I definedalmost all the variables so i might have made a mistake there.
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swFeature As SldWorks.Feature
Dim swSheetMetal As SldWorks.SheetMetalFeatureData
Dim swBody As SldWorks.Body2
Dim swMassProp As SldWorks.MassProperty
Dim SwConfig As SldWorks.Configuration
Dim swConfigMgr As SldWorks.ConfigurationManager
Dim swModelExtension As SldWorks.ModelDocExtension
Dim swCustomPropertyManager As SldWorks.CustomPropertyManager
Dim swConfigurationFlat As SldWorks.Configuration
Dim swModelExt As SldWorks.ModelDocExtension
Dim swMassProperty As SldWorks.MassProperty
Dim swPart As SldWorks.PartDoc
Dim lResults As Long
Dim dThickness As Double
Dim vResults As Variant
Dim dVolume As Double
Dim vConfig As Variant
Dim sResults As String
Dim bresults As Boolean
Dim vBody As Variant
Dim sMaterial As String
Dim dHoriz As Double
Dim dVert As Double
Sub main()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swFeature = swModel.FirstFeature
Do Until swFeature Is Nothing
If swFeature.GetTypeName = "SheetMetal" Then Exit Do
Set swFeature = swFeature.GetNextFeature
Loop
Set swSheetMetal = swFeature.GetDefinition
dThickness = swSheetMetal.Thickness
Set swModelExtension = swModel.Extension
Set swMassProp = swModelExtension.CreateMassProperty
Set SwConfig = swConfigMgr.ActiveConfiguration
lResults = SwConfig.GetChildrenCount
If lResults = 0 Then Exit Sub
vConfig = SwConfig.GetChildren
Set swCustomPropertyManager = SwConfig.CustomPropertyManager
Set swConfigurationFlat = vConfig(0)
Dim S As Integer
If UBound(vConfig) > 0 Then
sResults = swConfigurationFlat.Name
bresults = False
For S = 1 To Len(sResults) - 5
If Mid(sResults, S, 4) = "FLAT" Then
bresults = True
Exit For
End If
Next S
If bresults = False Then
Set swConfigurationFlat = vConfig(1)
End If
End If
swModel.ShowConfiguration2 (swConfigurationFlat.Name)
Set swModelExt = swModel.Extension
Set swMassProperty = swModelExt.CreateMassProperty
Set swPart = swModel
dVolume = swMassProperty.Volume
vBody = swPart.GetBodies2(swSolidBody, True)
Set swBody = vBody(0)
vResults = GetOutsideDimensions(swBody, dThickness, dVolume)
dThickness = Conversion(toin, dThickness)
sMaterial = swPart.MaterialIdName
dHoriz = Round(vResults(0) + 0.499, 0)
dVert = Round(vResults(1) + 0.499, 0)
End Sub
'You will also need the function GetOutsideDimensions
Function GetOutsideDimensions(swBody As SldWorks.Body2, dThicknessAs Double, dVolume As Double) As Variant
Dim swFace As SldWorks.Face2
Dim dArea As Double
Dim Normal As Variant
Dim dTrans(15) As Double
Dim vTrans As Variant
Dim dPoint(2) As Double
Dim vPoint As Variant
Dim swMathUtil As SldWorks.MathUtility
Dim swMathTrans As SldWorks.MathTransform
Dim swMathPoint As SldWorks.MathPoint
Dim vCorner1 As Variant
Dim vCorner2 As Variant
Dim vStartPoint As Variant
Dim vEndPoint As Variant
Dim vCenter As Variant
Dim dRadius As Double
Dim dAngle1 As Double
Dim dAngle2 As Double
Dim vCurveParams As Variant
Dim vCircleParams As Variant
Dim swEdge As SldWorks.Edge
Dim vEdges As Variant
Dim swLoop As SldWorks.Loop2
Dim vEdge As Variant
Dim dXmin As Double
Dim dXmax As Double
Dim dYmin As Double
Dim dYmax As Double
Dim bStart As Boolean
Dim Outside(1) As Double
Dim swCurve As SldWorks.Curve
Dim dResults As Double
Set swFace = swBody.GetFirstFace
Do While Not swFace Is Nothing
dArea = swFace.GetArea
If Abs((dArea * dThickness) - dVolume) < (dVolume * 0.1) Then
Exit Do
End If
Set swFace = swFace.GetNextFace
Loop
' Box = swFace.GetBox
Normal = swFace.Normal
dTrans(0) = Normal(2)
dTrans(1) = Normal(0)
dTrans(2) = Normal(1)
dTrans(3) = Normal(1)
dTrans(4) = Normal(2)
dTrans(5) = Normal(0)
dTrans(6) = Normal(0)
dTrans(7) = Normal(1)
dTrans(8) = Normal(2)
dTrans(9) = 0
dTrans(10) = 0
dTrans(11) = 0
dTrans(12) = 0
dTrans(13) = 0
dTrans(14) = 0
dTrans(15) = 0
vTrans = dTrans
Set swMathUtil = swApp.GetMathUtility
Set swMathTrans = swMathUtil.CreateTransform(vTrans)
Set swMathTrans = swMathTrans.Inverse
dCutLength = 0#
lPierceCount = swFace.GetLoopCount
Set swLoop = swFace.GetFirstLoop
Do
vEdges = swLoop.GetEdges
For Count = 0 To UBound(vEdges)
Set swEdge = vEdges(Count)
Set swCurve = swEdge.GetCurve
vEdgeParameters = swEdge.GetCurveParams2
dCurveLength = swCurve.GetLength3(vEdgeParameters(6),vEdgeParameters(7))
dCutLength = dCutLength + dCurveLength
Next Count
Set swLoop = swLoop.GetNext
If swLoop Is Nothing Then Exit Do
Loop
Set swLoop = swFace.GetFirstLoop
Do While Not swLoop Is Nothing
If swLoop.IsOuter Then Exit Do
Set swLoop = swLoop.GetNext
Loop
If swLoop.GetEdgeCount > 1 Then
vEdges = swLoop.GetEdges
bStart = False
For Each vEdge In vEdges
Set swEdge = vEdge
vCurveParams = swEdge.GetCurveParams2
dPoint(0) = vCurveParams(0)
dPoint(1) = vCurveParams(1)
dPoint(2) = vCurveParams(2)
vPoint = dPoint
Set swMathPoint = swMathUtil.CreatePoint(vPoint)
Set swMathPoint = swMathPoint.MultiplyTransform(swMathTrans)
vStartPoint = swMathPoint.ArrayData
dPoint(0) = vCurveParams(0)
dPoint(1) = vCurveParams(1)
dPoint(2) = vCurveParams(2)
vPoint = dPoint
Set swMathPoint = swMathUtil.CreatePoint(vPoint)
Set swMathPoint = swMathPoint.MultiplyTransform(swMathTrans)
vEndPoint = swMathPoint.ArrayData
If bStart = False Then
dXmin = vStartPoint(0)
dXmax = vStartPoint(0)
dYmin = vStartPoint(1)
dYmax = vStartPoint(1)
bStart = True
Else
If vStartPoint(0) < dXmin Then dXmin = vStartPoint(0)
If vStartPoint(0) > dXmax Then dXmax = vStartPoint(0)
If vStartPoint(1) < dYmin Then dYmin = vStartPoint(1)
If vStartPoint(1) > dYmax Then dYmax = vStartPoint(1)
End If
If vEndPoint(0) < dXmin Then dXmin = vEndPoint(0)
If vEndPoint(0) > dXmax Then dXmax = vEndPoint(0)
If vEndPoint(1) < dYmin Then dYmin = vEndPoint(1)
If vEndPoint(1) > dYmax Then dYmax = vEndPoint(1)
Next vEdge
Outside(0) = Conversion(toin, dXmax - dXmin)
Outside(1) = Conversion(toin, dYmax - dYmin)
GetOutsideDimensions = Outside
Else
' handle complete circle
vEdges = swLoop.GetEdges
Set swEdge = vEdges(0)
Set swCurve = swEdge.GetCurve
vResults = swCurve.CircleParams
dResults = vResults(6) * 2
Outside(0) = ConversionModule.Conversion(toin, dResults)
Outside(1) = ConversionModule.Conversion(toin, dResults)
GetOutsideDimensions = Outside
End If
End Function
'You will also need my unit conversion function
Function Conversion(NumericConversion, nValue As Double) As Double
' For SolidWorks all nominal units are in Meters
' therefore all conversions will be to or from Meters
Select Case NumericConversion
Case inin
Conversion = nValue * 0.0254
Case toin
Conversion = nValue * 39.3701
Case inMM
Conversion = nValue * 0.001
Case toMM
Conversion = nValue * 1000
Case inCM
Conversion = nValue * 0.01
Case toCM
Conversion = nValue * 100
Case inM
Conversion = nValue * 1#
Case toM
Conversion = nValue * 1#
Case inFT
Conversion = nValue * 0.3048
Case toFT
Conversion = nValue * 3.28084
Case Else
Debug.Print "Unrecognised unit type."
End Select
End Function
Thanks.SolidworksApi macros
The code pasted below is to get the length and width of a part andI have been having alot of trouble with it and was wondering ifsomebody could help me with it.
I have been playing with this code for quite some time now and justcannot figure out what is wrong. It errors out at "Set SwConfig =swConfigMgr.ActiveConfiguration" and also with the math utility. Ifound this code on this site but it was not complete so I definedalmost all the variables so i might have made a mistake there.
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swFeature As SldWorks.Feature
Dim swSheetMetal As SldWorks.SheetMetalFeatureData
Dim swBody As SldWorks.Body2
Dim swMassProp As SldWorks.MassProperty
Dim SwConfig As SldWorks.Configuration
Dim swConfigMgr As SldWorks.ConfigurationManager
Dim swModelExtension As SldWorks.ModelDocExtension
Dim swCustomPropertyManager As SldWorks.CustomPropertyManager
Dim swConfigurationFlat As SldWorks.Configuration
Dim swModelExt As SldWorks.ModelDocExtension
Dim swMassProperty As SldWorks.MassProperty
Dim swPart As SldWorks.PartDoc
Dim lResults As Long
Dim dThickness As Double
Dim vResults As Variant
Dim dVolume As Double
Dim vConfig As Variant
Dim sResults As String
Dim bresults As Boolean
Dim vBody As Variant
Dim sMaterial As String
Dim dHoriz As Double
Dim dVert As Double
Sub main()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swFeature = swModel.FirstFeature
Do Until swFeature Is Nothing
If swFeature.GetTypeName = "SheetMetal" Then Exit Do
Set swFeature = swFeature.GetNextFeature
Loop
Set swSheetMetal = swFeature.GetDefinition
dThickness = swSheetMetal.Thickness
Set swModelExtension = swModel.Extension
Set swMassProp = swModelExtension.CreateMassProperty
Set SwConfig = swConfigMgr.ActiveConfiguration
lResults = SwConfig.GetChildrenCount
If lResults = 0 Then Exit Sub
vConfig = SwConfig.GetChildren
Set swCustomPropertyManager = SwConfig.CustomPropertyManager
Set swConfigurationFlat = vConfig(0)
Dim S As Integer
If UBound(vConfig) > 0 Then
sResults = swConfigurationFlat.Name
bresults = False
For S = 1 To Len(sResults) - 5
If Mid(sResults, S, 4) = "FLAT" Then
bresults = True
Exit For
End If
Next S
If bresults = False Then
Set swConfigurationFlat = vConfig(1)
End If
End If
swModel.ShowConfiguration2 (swConfigurationFlat.Name)
Set swModelExt = swModel.Extension
Set swMassProperty = swModelExt.CreateMassProperty
Set swPart = swModel
dVolume = swMassProperty.Volume
vBody = swPart.GetBodies2(swSolidBody, True)
Set swBody = vBody(0)
vResults = GetOutsideDimensions(swBody, dThickness, dVolume)
dThickness = Conversion(toin, dThickness)
sMaterial = swPart.MaterialIdName
dHoriz = Round(vResults(0) + 0.499, 0)
dVert = Round(vResults(1) + 0.499, 0)
End Sub
'You will also need the function GetOutsideDimensions
Function GetOutsideDimensions(swBody As SldWorks.Body2, dThicknessAs Double, dVolume As Double) As Variant
Dim swFace As SldWorks.Face2
Dim dArea As Double
Dim Normal As Variant
Dim dTrans(15) As Double
Dim vTrans As Variant
Dim dPoint(2) As Double
Dim vPoint As Variant
Dim swMathUtil As SldWorks.MathUtility
Dim swMathTrans As SldWorks.MathTransform
Dim swMathPoint As SldWorks.MathPoint
Dim vCorner1 As Variant
Dim vCorner2 As Variant
Dim vStartPoint As Variant
Dim vEndPoint As Variant
Dim vCenter As Variant
Dim dRadius As Double
Dim dAngle1 As Double
Dim dAngle2 As Double
Dim vCurveParams As Variant
Dim vCircleParams As Variant
Dim swEdge As SldWorks.Edge
Dim vEdges As Variant
Dim swLoop As SldWorks.Loop2
Dim vEdge As Variant
Dim dXmin As Double
Dim dXmax As Double
Dim dYmin As Double
Dim dYmax As Double
Dim bStart As Boolean
Dim Outside(1) As Double
Dim swCurve As SldWorks.Curve
Dim dResults As Double
Set swFace = swBody.GetFirstFace
Do While Not swFace Is Nothing
dArea = swFace.GetArea
If Abs((dArea * dThickness) - dVolume) < (dVolume * 0.1) Then
Exit Do
End If
Set swFace = swFace.GetNextFace
Loop
' Box = swFace.GetBox
Normal = swFace.Normal
dTrans(0) = Normal(2)
dTrans(1) = Normal(0)
dTrans(2) = Normal(1)
dTrans(3) = Normal(1)
dTrans(4) = Normal(2)
dTrans(5) = Normal(0)
dTrans(6) = Normal(0)
dTrans(7) = Normal(1)
dTrans(8) = Normal(2)
dTrans(9) = 0
dTrans(10) = 0
dTrans(11) = 0
dTrans(12) = 0
dTrans(13) = 0
dTrans(14) = 0
dTrans(15) = 0
vTrans = dTrans
Set swMathUtil = swApp.GetMathUtility
Set swMathTrans = swMathUtil.CreateTransform(vTrans)
Set swMathTrans = swMathTrans.Inverse
dCutLength = 0#
lPierceCount = swFace.GetLoopCount
Set swLoop = swFace.GetFirstLoop
Do
vEdges = swLoop.GetEdges
For Count = 0 To UBound(vEdges)
Set swEdge = vEdges(Count)
Set swCurve = swEdge.GetCurve
vEdgeParameters = swEdge.GetCurveParams2
dCurveLength = swCurve.GetLength3(vEdgeParameters(6),vEdgeParameters(7))
dCutLength = dCutLength + dCurveLength
Next Count
Set swLoop = swLoop.GetNext
If swLoop Is Nothing Then Exit Do
Loop
Set swLoop = swFace.GetFirstLoop
Do While Not swLoop Is Nothing
If swLoop.IsOuter Then Exit Do
Set swLoop = swLoop.GetNext
Loop
If swLoop.GetEdgeCount > 1 Then
vEdges = swLoop.GetEdges
bStart = False
For Each vEdge In vEdges
Set swEdge = vEdge
vCurveParams = swEdge.GetCurveParams2
dPoint(0) = vCurveParams(0)
dPoint(1) = vCurveParams(1)
dPoint(2) = vCurveParams(2)
vPoint = dPoint
Set swMathPoint = swMathUtil.CreatePoint(vPoint)
Set swMathPoint = swMathPoint.MultiplyTransform(swMathTrans)
vStartPoint = swMathPoint.ArrayData
dPoint(0) = vCurveParams(0)
dPoint(1) = vCurveParams(1)
dPoint(2) = vCurveParams(2)
vPoint = dPoint
Set swMathPoint = swMathUtil.CreatePoint(vPoint)
Set swMathPoint = swMathPoint.MultiplyTransform(swMathTrans)
vEndPoint = swMathPoint.ArrayData
If bStart = False Then
dXmin = vStartPoint(0)
dXmax = vStartPoint(0)
dYmin = vStartPoint(1)
dYmax = vStartPoint(1)
bStart = True
Else
If vStartPoint(0) < dXmin Then dXmin = vStartPoint(0)
If vStartPoint(0) > dXmax Then dXmax = vStartPoint(0)
If vStartPoint(1) < dYmin Then dYmin = vStartPoint(1)
If vStartPoint(1) > dYmax Then dYmax = vStartPoint(1)
End If
If vEndPoint(0) < dXmin Then dXmin = vEndPoint(0)
If vEndPoint(0) > dXmax Then dXmax = vEndPoint(0)
If vEndPoint(1) < dYmin Then dYmin = vEndPoint(1)
If vEndPoint(1) > dYmax Then dYmax = vEndPoint(1)
Next vEdge
Outside(0) = Conversion(toin, dXmax - dXmin)
Outside(1) = Conversion(toin, dYmax - dYmin)
GetOutsideDimensions = Outside
Else
' handle complete circle
vEdges = swLoop.GetEdges
Set swEdge = vEdges(0)
Set swCurve = swEdge.GetCurve
vResults = swCurve.CircleParams
dResults = vResults(6) * 2
Outside(0) = ConversionModule.Conversion(toin, dResults)
Outside(1) = ConversionModule.Conversion(toin, dResults)
GetOutsideDimensions = Outside
End If
End Function
'You will also need my unit conversion function
Function Conversion(NumericConversion, nValue As Double) As Double
' For SolidWorks all nominal units are in Meters
' therefore all conversions will be to or from Meters
Select Case NumericConversion
Case inin
Conversion = nValue * 0.0254
Case toin
Conversion = nValue * 39.3701
Case inMM
Conversion = nValue * 0.001
Case toMM
Conversion = nValue * 1000
Case inCM
Conversion = nValue * 0.01
Case toCM
Conversion = nValue * 100
Case inM
Conversion = nValue * 1#
Case toM
Conversion = nValue * 1#
Case inFT
Conversion = nValue * 0.3048
Case toFT
Conversion = nValue * 3.28084
Case Else
Debug.Print "Unrecognised unit type."
End Select
End Function
Thanks.SolidworksApi macros
