Herstel de bestandsextensie van de waarde

Out of category
1

 Hallo allemaal.
Ik heb een klein niveau in VBA. Ik heb een code gekregen die ik heb aangepast naar aanleiding van uw advies op dit forum.
Beginnend met een assemblage, kunt u de stuklijst exporteren naar een plaat .xls
Het werkt perfect, maar ik zou graag de mogelijkheid willen toevoegen om de extensie van de bestanden in de kolom op te halen : J. 
De variabele waarmee u de extensie kunt ophalen is als volgt: Right(docfilename , 6)
 Hoe integreer ik deze variabele in mijn programma?

 

Sub hoofd()

Dim xlApp als Excel.Application
Stel xlApp in = Nieuwe Excel.Toepassing
Dim wbk als Excel.Workbook
Dim sht als Excel.Werkblad

Met xlApp
    . Zichtbaar = Waar
    Stel wbk in = . Werkmappen.Toevoegen
    Stel sht in = wbk. Actief blad
Eindigen met

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
Stel swModelDocExt = swModel.Extension in

TemplateName = "M:\DATABASE\TEMPLATES\05-Model van nomenclatuur\GP_ASM_Nomenclature BOS.sldbomtbt"
BomType = swBomType_Indented
Configuratie = swApp.GetActiveConfigurationName(swModel.GetPathName)
MsgBox-configuratie
Stel swBOMAnnotatie in = swModelDocExt.InsertBomTable3(TemplateName, 0, 0, BomType, Configuratie, False, swNumberingType_Detailed, True)
Stel swBOMFeature = swBOMAnnotation.BomFeature in

swModel.ForceRebuild3 Waar

Dim NumCol zo lang
Dim NumRow zo lang
Dim ik zo lang
Zon J Zo lang

NumCol = swBOMAnnotatie.ColumnCount
NumRow = swBOMAnnotatie.RowCount

Voor I = 0 om te numrowen
    Voor J = 0 TB NumCol
        Sht. Cellen (I + 1, J + 1). Waarde = swBOMAnnotatie.Tekst(I, J)
    Volgende J
Volgende I

boolstatus = swModelDocExt.SelectByID2(swBOMFeature.GetFeature.Description, "BOMFEATURE", 0, 0, 0, True, 0, Nothing, 0)
swModel.EditDelete

Dim pad als snaar
path = "C:\temp\BOS.xlsx"

Met xlApp
    wbk. Pad OpslaanAls
    wbk. Sluiten
    . Verlaten
Eindigen met

Einde Sub

2

Hallo

U zou moeten zien met het volgende API-helpcodefragment: http://help.solidworks.com/2019/english/api/sldworksapi/Get_Components_in_Each_BOM_Table_Row_VB.htm

 

 

3

Als ik het goed begrijp, maakt uw programma een nomenclatuur en gaat er vervolgens doorheen om de inhoud op te halen.

U zou een screenshot van uw nomenclatuur (de lijst met kolommen) moeten hebben.

Persoonlijk voeg ik een kolom toe aan de stuklijst die de volledige naam van het bestand ophaalt.
We hebben dan 2 mogelijkheden:
- Behandel de cel met VBA;
- Gebruik XL-functies.

In VBA doe je een tweede lus met zoiets als dit:
Sht. Cellen (I + 1, colonne_nom_fichier). Waarde = Rechts( sht. Cellen (I + 1, colonne_nom_fichier). Waarde, 6)

4

Het idee om een kolom in de stuklijst toe te voegen die de volledige naam van het bestand ophaalt, is een goed idee.

Helaas bevat SolidWorks niet de optie om de bestandsnaam en extensie op te halen .

5

Aangezien het mogelijk is om met de rechtermuisknop te klikken om het bestand van een regel van de BOM te openen, kunt u de naam misschien op deze manier ophalen (door een opening te simuleren)?

De afbeelding is niet leesbaar (dat is het probleem met dit forum), het moet worden bijgevoegd.

6

Pcs


capture.jpg
7

Hallo

De link die ik heb geplaatst, stelt je in staat om in de stuklijst te lussen om het volledige pad (met extensie) op te halen.

8

Cyril. Bedankt voor de links. Ik kan dit programma niet starten, het plaatst een foutmelding op de 7e regel.

Hoe heb je het voor elkaar gekregen om het te testen? Ik denk dat ik geen fout heb gemaakt, maar ik kan er niet achter komen wat :/ 

9

Hallo

Ik heb er net een plan op gegooid met een nomenclatuur. Waar plant het? (7e regel, ik weet niet zeker of ik de juiste heb)

10

In mijn geval gebeurt er niets :O

Kunt u een screenshot maken van de verkregen resultaten ?

 

-----------------------------------

Voorwaarden:
" 1. Open public_documents \samples\tutorial\assemblyvisual\food_processor.sldasm.
'2. Maak een tekening van de montage.
"3. Selecteer Invoegen> Tabellen> Stuklijst .
"4. Zorg ervoor dat de optie Alleen onderdelen in stuklijsttype is geselecteerd.
"5. Zorg ervoor dat de optie Configuraties weergeven in dezelfde ruimte als afzonderlijke items
" in Onderdeelconfiguratie Groepering is geselecteerd.
"6.  Klik op OK .
'7. Klik op een willekeurige plaats in de tekening om de stuklijsttabel in te voegen.
'
' Postvoorwaarden:
"1.BOM-functionaliteit1 .
"2. Hiermee haalt u de standaardconfiguratie op. 
"3. Verwerkt de stuklijsttabel voor de standaardconfiguratie . 
'4. Bekijk het venster Uitvoering.
'
' LET OP : Aangezien het sjabloon elders wordt gebruikt, dient u de wijzigingen niet op te slaan

11

Hallo

Bijgevoegd is een screenshot.


macro_sw_get_coponent_in_bom.jpg
12

Bedankt. Het resultaat zit in het uitvoeringsgedeelte. Hoe doe je dat, ga naar het xls-blad?

13

Hallo

Hieronder vindt u de integratie van de voorbeeld-API. Ik heb niet gecontroleerd of de variabele docfilename leeg is .

Dim vPtArr As Variant
Dim swComp As Object
Dim pt As Object
Dim compPath As String
Dim docfilename As String

Sub main()

Dim xlApp As Excel.Application
Set xlApp = New Excel.Application
Dim wbk As Excel.Workbook
Dim sht As Excel.Worksheet

With xlApp
    .Visible = True
    Set wbk = .Workbooks.Add
    Set sht = wbk.ActiveSheet
End With

Dim swApp                   As SldWorks.SldWorks
Dim swModel                 As SldWorks.ModelDoc2
Dim swModelDocExt           As SldWorks.ModelDocExtension
Dim swBOMAnnotation         As SldWorks.BomTableAnnotation
Dim swBOMFeature            As SldWorks.BomFeature
Dim boolstatus              As Boolean
Dim BomType                 As Long
Dim Configuration           As String
Dim TemplateName            As String

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
Set swModelDocExt = swModel.Extension

TemplateName = "M:\DATABASE\MODELES\05-Model de nomenclature\GP_ASM_Nomenclature BOS.sldbomtbt"
BomType = swBomType_Indented
Configuration = swApp.GetActiveConfigurationName(swModel.GetPathName)
MsgBox Configuration
Set swBOMAnnotation = swModelDocExt.InsertBomTable3(TemplateName, 0, 0, BomType, Configuration, False, swNumberingType_Detailed, True)
Set swBOMFeature = swBOMAnnotation.BomFeature

swModel.ForceRebuild3 True

Dim NumCol As Long
Dim NumRow As Long
Dim I As Long
Dim J As Long

NumCol = swBOMAnnotation.ColumnCount
NumRow = swBOMAnnotation.RowCount

For I = 0 To NumRow
    vPtArr = swBOMAnnotation.GetComponents2(I, Configuration)
    If (Not IsEmpty(vPtArr)) Then
        For K = 0 To UBound(vPtArr)
            Set pt = vPtArr(K)
            Set swComp = pt
            If Not swComp Is Nothing Then
                docfilename = swComp.GetPathName
            End If
        Next K
    End If
    For J = 0 To NumCol
        sht.Cells(I + 1, J + 1).Value = swBOMAnnotation.Text(I, J)
    Next J
    If I > 0 Then
        sht.Cells(I + 1, J).Value = Right(docfilename, 6)
    End If
Next I

boolstatus = swModelDocExt.SelectByID2(swBOMFeature.GetFeature.Description, "BOMFEATURE", 0, 0, 0, True, 0, Nothing, 0)
swModel.EditDelete

Dim chemin As String
chemin = "C:\temp\BOS.xlsx"

With xlApp
    wbk.SaveAs chemin
    wbk.Close
    .Quit
End With

End Sub

 

3 likes
14

Bedankt voor de code:)

Ik heb gewoon een klein probleem met Li13, Col 1 compilatiefout

15

Je moet een screenshot maken van de foutmelding, want Li13,Col1 is een lege regel voor mij.

16

Erratum :) Li 8, Col 1


capture.jpg
17

Dit is niet de lijn waar het probleem zit, maar waar de cursor zit.

Dus ik zal zeggen dat Dim K zo lang ontbreekt

Kijk anders in de referenties (tools > References) en het zou eruit moeten zien als de schermafbeelding die bij het versienummer is gevoegd.


references_vba.jpg
1 like
18

Cyril.f Bravo en dank u:D

Dit kwam eigenlijk van de optie: Microsoft Excel 16.0 Object Library