I have a macro that traverses the assembly, then exports to atext file. How can I delete duplicate entrys using the API ?
Ex.
006002322
999004343
999003434
999006443
999004343 <---delete this one since its a duplicate
999002223
999001121
See below for the code I am using.
Thanks.
Option Explicit
Sub TraverseComponent(swComp As SldWorks.Component2, nLevel AsLong)
Dim vChildComp As Variant
Dim swChildComp As SldWorks.Component2
Dim Part As ModelDoc2
Dim swCompConfig As SldWorks.Configuration
Dim Desc, Item, Ptype As String
Dim i, j As Long
Dim retval As String
Dim partsupp As String
Dim cpitem As String
Dim PName, fname As String
Dim ptrFname As Long
Dim textout As String
For i = 0 To nLevel - 1
j = j + 1
Next i
vChildComp = swComp.GetChildren
For i = 0 To UBound(vChildComp)
Set swChildComp = vChildComp(i)
TraverseComponent swChildComp, nLevel + 1
'checks to see if the current model is suppressed
partsupp = swChildComp.GetSuppression
'if current model is suppressed, skip custom property extraction
If partsupp = "0" Then
GoTo Skip
Else
PName = swChildComp.GetPathName()
ptrFname = InStrRev(PName, "\") + 1
fname = Mid(PName, ptrFname)
ptrFname = InStr(fname, ".") - 1
fname = Left(fname, ptrFname)
Set Part = swChildComp.GetModelDoc()
'extracts the Item and Description custom property from the model
Item = Part.CustomInfo2("", "Item")
Desc = Part.CustomInfo2("", "Description")
'checks to see if the Item CP for the current document is blank, ifso the item is flagged in the text file
If Item = "" Then
textout = fname & " does not have an Item # *****"
Debug.Print textout
Print #1, textout
Else
'sends the custom property data extracted to the text file
Debug.Print Item & "," & Desc
Print #1, Item & "," & Desc
Skip:
End If
End If
Next i
End Sub
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swAssy As SldWorks.AssemblyDoc
Dim swConf As SldWorks.Configuration
Dim swRootComp As SldWorks.Component2
Dim fname As String
Dim Unit As Long
Dim MainItem As String
Dim MainDesc As String
Dim AssyItem As String
Dim CurDate As String
Unit = 1
Set swApp = CreateObject("SldWorks.Application")
Set swModel = swApp.ActiveDoc
'checks to see if an assembly is open
If swModel.GetType <> swDocASSEMBLY Then
MsgBox ("This macro only works with assemblies.")
Exit Sub
End If
Set swConf = swModel.GetActiveConfiguration
Set swRootComp = swConf.GetRootComponent
AssyItem = swModel.GetCustomInfoValue("", "Item")
CurDate = Date
fname = "C:\Temp\" + AssyItem + "-" + CurDate + ".txt"
Open fname For Output As Unit
'Extracts the Item and Description from the main assembly
MainItem = swModel.GetCustomInfoValue("", "Item")
MainDesc = swModel.GetCustomInfoValue("", "Description")
Debug.Print MainItem & "," & MainDesc
Print #1, MainItem & "," & MainDesc
TraverseComponent swRootComp, 1
Close Unit
End Sub
SolidworksApi macros
Ex.
006002322
999004343
999003434
999006443
999004343 <---delete this one since its a duplicate
999002223
999001121
See below for the code I am using.
Thanks.
Option Explicit
Sub TraverseComponent(swComp As SldWorks.Component2, nLevel AsLong)
Dim vChildComp As Variant
Dim swChildComp As SldWorks.Component2
Dim Part As ModelDoc2
Dim swCompConfig As SldWorks.Configuration
Dim Desc, Item, Ptype As String
Dim i, j As Long
Dim retval As String
Dim partsupp As String
Dim cpitem As String
Dim PName, fname As String
Dim ptrFname As Long
Dim textout As String
For i = 0 To nLevel - 1
j = j + 1
Next i
vChildComp = swComp.GetChildren
For i = 0 To UBound(vChildComp)
Set swChildComp = vChildComp(i)
TraverseComponent swChildComp, nLevel + 1
'checks to see if the current model is suppressed
partsupp = swChildComp.GetSuppression
'if current model is suppressed, skip custom property extraction
If partsupp = "0" Then
GoTo Skip
Else
PName = swChildComp.GetPathName()
ptrFname = InStrRev(PName, "\") + 1
fname = Mid(PName, ptrFname)
ptrFname = InStr(fname, ".") - 1
fname = Left(fname, ptrFname)
Set Part = swChildComp.GetModelDoc()
'extracts the Item and Description custom property from the model
Item = Part.CustomInfo2("", "Item")
Desc = Part.CustomInfo2("", "Description")
'checks to see if the Item CP for the current document is blank, ifso the item is flagged in the text file
If Item = "" Then
textout = fname & " does not have an Item # *****"
Debug.Print textout
Print #1, textout
Else
'sends the custom property data extracted to the text file
Debug.Print Item & "," & Desc
Print #1, Item & "," & Desc
Skip:
End If
End If
Next i
End Sub
Sub main()
Dim swApp As SldWorks.SldWorks
Dim swModel As SldWorks.ModelDoc2
Dim swAssy As SldWorks.AssemblyDoc
Dim swConf As SldWorks.Configuration
Dim swRootComp As SldWorks.Component2
Dim fname As String
Dim Unit As Long
Dim MainItem As String
Dim MainDesc As String
Dim AssyItem As String
Dim CurDate As String
Unit = 1
Set swApp = CreateObject("SldWorks.Application")
Set swModel = swApp.ActiveDoc
'checks to see if an assembly is open
If swModel.GetType <> swDocASSEMBLY Then
MsgBox ("This macro only works with assemblies.")
Exit Sub
End If
Set swConf = swModel.GetActiveConfiguration
Set swRootComp = swConf.GetRootComponent
AssyItem = swModel.GetCustomInfoValue("", "Item")
CurDate = Date
fname = "C:\Temp\" + AssyItem + "-" + CurDate + ".txt"
Open fname For Output As Unit
'Extracts the Item and Description from the main assembly
MainItem = swModel.GetCustomInfoValue("", "Item")
MainDesc = swModel.GetCustomInfoValue("", "Description")
Debug.Print MainItem & "," & MainDesc
Print #1, MainItem & "," & MainDesc
TraverseComponent swRootComp, 1
Close Unit
End Sub
SolidworksApi macros