Ik heb deze fout nu!
Sub hoofd()
Dim xlApp als object
Dim wbk als object 'niet werkboek
Dim sht Als Object 'niet Werkblad
'indien nodig: Dim rng As Object ‹ not Range ›
Dim swApp als SldWorks.SldWorks
Dim swModel als SldWorks.ModelDoc2
Dim swModelDocExt als SldWorks.ModelDocExtension
Dim swBOMAnnotatie als SldWorks.BomTableAnnotation
Dim swBOMFeature As SldWorks.BomFeature
Dim boolstatus als Booleaanse
Dim BomType zo lang
Dim configuratie als tekenreeks
Dim TemplateName als tekenreeks
Stel swApp = Toepassing.SldWorks in
Stel swModel = swApp.ActiveDoc in
Als swModel niets is, dan
swApp.SendMsgToUser2 (' Geen actieve assemblage gedetecteerd. '), swMbWarning, swMbOk'-testdocumentactiviteit
Sub afsluiten
ElseIf swModel.GetType <> swDocASSEMBLY Dan
swApp.SendMsgToUser2 (' Geen actieve assembly gedetecteerd. '), swMbWarning, swMbOk' test dat het bestand een assembly is
Sub afsluiten
ElseIf swModel.GetPathName = " " Dan
swApp.SendMsgToUser2 ( ' Niet-geregistreerde assembly. '), swMbWarning, swMbOk' test dat assembly is geregistreerd
Sub afsluiten
Einde als
Stel swModelDocExt = swModel.Extension in
Set xlApp = CreateObject(" Excel.Application ")
Stel wbk in = xlApp.Workbooks.Open(" ... Nomenclature.xls") ' het sjabloon openen ‹ of een nieuw sjabloon maken: Stel wbk = xlApp.Workbooks.Add in
‹ indien nodig: Bestaande plaatselectie: Sht = wbk instellen. Werkbladen(1) ›: een spreadsheet toegevoegdStel wks = wbk in. Bladen.Toevoegen ›
‹ indien nodig: Een cel selecteren: Stel rng = thisWs.Range(" A11 ") in ›
Sjabloonnaam = " ... Detailed.sldbomtbt » ‹ Het maken van de Solidworks Automatische Stuklijst volgens model ›
BomType = swBomType_Indented
Configuratie = " Standaard" ‹ naam van de ingestelde configuratie ›
Stel swBOMAnnotatie in = swModelDocExt.InsertBomTable3(TemplateName, 0, 0, BomType, Configuratie, False, swNumberingType_Detailed, False)
Stel swBOMFeature = swBOMAnnotation.BomFeature in
swModel.ForceRebuild3 Waar
Dim NumCol zo lang
Dim NumRow zo lang
Zon i Zo lang
Zon J Zo lang
NumCol = swBOMAnnotatie.ColumnCount
NumRow = swBOMAnnotatie.RowCount
Dim rij zo lang
rij = 0
Voor i = 0 om te numrowen
Dim itemNum As String, partnum As String
swBOMAnnotation.GetComponentsCount2 i + 1, "", itemNum, partnum
If isValidPart2(partnum) = False Then GoTo next_i
For J = 0 To NumCol
wbk.Sheets("Nomenclature").Cells(row + 9, J + 1) = swBOMAnnotation.Text(i + 1, J)
Next J
row = row + 1
next_i:
volgende i
boolstatus = swModelDocExt.SelectByID2(swBOMFeature.GetFeature.Description, " BOMFEATURE ", 0, 0, 0, True, 0, Niets, 0)
swModel.EditDelete
swModel.ForceRebuild3 Waar
Dim config As SldWorks.Configuration
Dim cusPropMgr As SldWorks.CustomPropertyManager
Dim lRetVal zo lang
Dim ValOut als snaar
Dim ResolvedValOut als tekenreeks
Dim wasOpgelost als Booleaanse
Dim nNbrProps zo lang
Dim vPropNames als variant
Dim vPropTypes als variant
Dim vPropValues als variant
Dim opgelost als variant
Dim custPropType zo lang
Dim K zo lang
Dim PropertyName1 als tekenreeks
Dim PropertyName2 als tekenreeks
Dim PropertyName3 als tekenreeks
Dim PropertyName4 als tekenreeks
Dim PropertyName5 als tekenreeks
Dim PropertyName6 als tekenreeks
Dim PropertyName7 als tekenreeks
Dim DateStr als datum
Set config = swModel.GetActiveConfiguration ': verwijst naar de solidworks-eigenschappen van het huidige document
‹ Stel cusPropMgr = config in. CustomPropertyManager ›: Configuratiespecifieke eigenschappen ophalen (Solidworks > eigenschappen> configuratiespecifieke eigenschappen.
Stel cusPropMgr = swModelDocExt.CustomPropertyManager(" ") in
nNbrProps = cusPropMgr.Count
vPropNames = cusPropMgr.GetNames
Voor K = 0 Naar nNbrProps - 1
cusPropMgr.Get2 vPropNames(K), ValOut, ResolvedValOut
custPropType = cusPropMgr.GetType2(vPropNames(K))
If vPropNames(K) = "N° de projet" Then 'récupération de la propriété "N° de projet"'
NomProperty1 = ResolvedValOut
wbk.Sheets("Nomenclature").Cells(1, 3) = NomProperty1
End If
If vPropNames(K) = "N° Plan / Réf / Dim" Then
NomProperty2 = ResolvedValOut
wbk.Sheets("Nomenclature").Cells(1, 5) = "-" & NomProperty2
End If
If vPropNames(K) = "Nom de projet" Then
NomProperty3 = ResolvedValOut
wbk.Sheets("Nomenclature").Cells(3, 3) = NomProperty3
End If
If vPropNames(K) = "Désignation" Then
NomProperty4 = ResolvedValOut
wbk.Sheets("Nomenclature").Cells(5, 3) = NomProperty4
End If
If vPropNames(K) = "Dessinateur" Then
NomProperty5 = ResolvedValOut
wbk.Sheets("Nomenclature").Cells(2, 7) = " Dessinateur : " & NomProperty5
End If
If vPropNames(K) = "Vérificateur" Then
NomProperty6 = ResolvedValOut
wbk.Sheets("Nomenclature").Cells(3, 7) = " Vérificateur : " & NomProperty6
End If
If vPropNames(K) = "Indice en cours" Then
NomProperty7 = ResolvedValOut
wbk.Sheets("Nomenclature").Cells(4, 7) = " Indice en cours : " & NomProperty7
End If
Volgende K
wbk. Bladen (" Nomenclatuur "). Cells(1, 6) = " Datum: " & DateValue(Nu)
Dim pad als snaar
path = Strings.Left(swModel.GetPathName, Len(swModel.GetPathName) - 7) & " - " & PropertyName7 & " -Detailed " & " .xlsx " " Vul het pad en de recordnaam in ' & PropertyName: Een aangepaste eigenschap toegevoegd aan de bestandsnaam
Met xlApp
.DisplayAlerts = False
.EnableEvents = False
wbk.SaveAs chemin 'enregistre le fichier et écrase si fichier déjà existant
.DisplayAlerts = True
.EnableEvents = True
wbk.Close 'ferme le workbook
.Quit 'quitte excel
Eindigen met
swApp.SendMsgToUser2 ("BOM van de gehele gemaakte machine. "), swMbInformation, swMbOk 'msgbox solidworks
Einde Sub
Functie isValidPart2(str As String) As Booleaanse
isValidPart2 = False
If str = "" Then Exit Function
Dim i As Long
For i = 1 To Len(str)
If Mid(str, i, 1) <> " " Then
isValidPart2 = True
Exit Function
End If
Next i
Functie beëindigen
