Here is my my macro, Solidworks tells me that it cannot calculate because of a type incompatibility for the calculation of XDim YDim and ZDim.
The goal of my macro is to collect parameters from the general assembly, then to collect the parameters from all the components.
Each parameter is transcribed into an XML file which is exported at the end of the macro.
I can't find where this type incompatibility comes from.
Sub AddCustomProperties()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swAssembly As SldWorks.AssemblyDoc
Dim swPart As SldWorks.PartDoc
Dim swComp As SldWorks.Component2
Dim swCustPropMgr As SldWorks.CustomPropertyManager
Dim swFeatMgr As SldWorks.FeatureManager
Dim swFeat As SldWorks.Feature
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Dim xmlCode As String
Dim filePath As String
Dim fso As Object
Dim ts As Object
If Not swModel Is Nothing Then
If swModel.GetType = swDocumentTypes_e.swDocASSEMBLY Then
Set swAssembly = swModel
Set swCustPropMgr = swAssembly.Extension.CustomPropertyManager("")
asmName = swModel.GetTitle
asmName = Left(asmName, Len(asmName) - 7)
Debug.Print "assembly name: " & asmName
Dim CustomerVal As String
CustomerVal = swCustPropMgr.Get("Customer")
Dim ProjectVal As String
ProjectVal = swCustPropMgr.Get("Project")
Dim components As Variant
components = swAssembly.GetComponents(False)
If Not IsEmpty(components) Then
partsCount = UBound(components) - LBound(components) + 1
Else
End If
Debug.Print "count:" & partsCount
xmlCode = "<Document>" & vbCrLf & _
> " <IdentifiantSW></" & Name & ">" & vbCrLf & _
> " <Configuration>" & vbCrLf & _
> " <Metadata>" & vbCrLf & _
> " <Customer></" & CustomerVal & ">" & vbCrLf & _
> " <Project></" & ProjectVal & ">" & vbCrLf & _
> " </Metadata>" & vbCrLf & _
> " </Configuration>" & vbCrLf & _
> " <BOM>" & vbCrLf
For i = 0 To partsCount - 1
Set swComp = swAssembly.GetComponents(False)(i)
Debug.Print "component:" & swComp.Name
If Not swComp Is Nothing Then
Set swPart = swComp.GetModelDoc2
Set swCustPropMgr = swPart.Extension.CustomPropertyManager("")
Dim partNum As String
partNum = swComp.Name
partNum = Left(partNum, Len(partNum) - 2)
Dim qty As Integer
qty = 1
Dim Color As String
Color = swCustPropMgr.Get("Color")
Dim Material As String
Material = swCustPropMgr.Get("Material")
Dim finish As String
finish = swCustPropMgr.Get("Finish")
Dim Process As String
Process = swCustPropMgr.Get("Process")
Dim vBox As Variant
vBox = swComp.GetBox(False, False)
Dim XDim As Double
Dim YDim As Double
Dim ZDim As Double
XDim = vBox(3) - vBox(0)
YDim = vBox(4) - vBox(1)
ZDim = vBox(5) - vBox(2)
xmlCode = xmlCode & " <ListComponents>" & vbCrLf & _
> " <Component>" & vbCrLf & _
> " <Part Number></" & partNum & ">" & vbCrLf & _
> " <Description></Description>" & vbCrLf & _
> " <Quantity></" & qty & ">" & vbCrLf & _
> " <Material></" & Material & ">" & vbCrLf & _
> " <Color></" & Color & ">" & vbCrLf & _
> " <Finish></" & finish & ">" & vbCrLf & _
> " <Process></" & Process & ">" & vbCrLf & _
> " <Dimensions>" & vbCrLf & _
> " <X>" & XDim & "</X>" & vbCrLf & _
> " <Y>" & YDim & "</Y>" & vbCrLf & _
> " <Z>" & ZDim & "</Z>" & vbCrLf & _
> " </Component>" & vbCrLf & _
> " </ListComponents>" & vbCrLf
Else
MsgBox "Le composant n'a pas été trouvé dans l'assemblage"
End If
Next i
xmlCode = xmlCode & " </BOM>" & vbCrLf & _
> "</Document>"
MsgBox ("Generated the XML file successfully")
Else
MsgBox "Veuillez ouvrir un fichier SolidWorks."
End If
Else
MsgBox "Veuillez ouvrir un fichier SolidWorks."
End If
swModel.Save
filePath = "C:\Property.xml"
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.CreateTextFile(filePath, True)
ts.Write xmlCode
ts.Close
Set swCustPropMgr = Nothing
Set swPart = Nothing
Set swComp = Nothing
Set swAssembly = Nothing
Set swModel = Nothing
Set swApp = Nothing
End Sub