Cze wszystkim
Celem jest automatyczne utworzenie za pomocą makra VBA nazwy w zespole, wyeksportowanie jej do pliku Excel, którego nazwa będzie nazwą pliku części + właściwością niestandardową. Na koniec makro musi usunąć utworzone zestawienie komponentów.
Nie mamy narzędzi My Cad - Solidworks Prenium
Witam
Wygląda to bardzo jak ogłoszenie o pracę lol
W przeciwnym razie zacząłeś patrzeć na rejestrator makr?
Pozdrowienia
Witam
Czy masz już fragment kodu, który możesz nam pokazać?
Dimitri.
Witam
Spójrz na załączone makro, zwykle wszystko tam jest (trochę luźno i bez kontroli bezpieczeństwa). Zmień przynajmniej wiersze:
TemplateName = "Z:\Model_SW\Nomenklatura.sldbomtbt"
Konfiguracja = "Domyślnie"
Jeśli vPropNames(K) = "RYSOWNIK" Następnie
Aby umieścić ścieżkę do szablonu BOM, nazwę konfiguracji domyślnej w programie asms oraz nazwę właściwości niestandardowej, która ma być w nazwie pliku.
Pozdrowienia
Dziękuję za odpowiedź d.roger, makro działa, tylko mały problem, kiedy umieściłem właściwość niestandardową w miejscu, w którym powiedziałeś mi, że wartość właściwości nie jest zwracana w nazwie pliku. Mam wrażenie, że w wierszu tworzącym nazwę pliku w makrze, nie ma przypomnienia o właściwości, próbowałem ją dodać ale testy nie są jednoznaczne po tej stronie.
Witam
Musisz zamienić 2 linie:
Ustaw config = swModel.GetActiveConfiguration
Ustaw cusPropMgr = config. CustomPropertyManager
, które pobierają wartość żądaną w aktywnej konfiguracji poprzez:
Ustaw cusPropMgr = swModelDocExt.CustomPropertyManager("")
który pobierze wartość w zakładce "Dostosuj"
Pozdrowienia
Idealnie, dokonując tej modyfikacji, makro działa tak, jak chciałem. Tylko po to, aby ulepszyć, można zapisać arkusz kalkulacyjny w tym samym folderze co zespół.
Witam
Tak, jest to możliwe, wymieniasz linię:
path = About("USERPROFILE") & "\Desktop\" & Left(swModel.GetTitle, Len(swModel.GetTitle) - 7) & "-" & PropertyName & ".xlsx"
przez:
path = Left(swModel.GetPathName, Len(swModel.GetPathName) - 7) & "-" & NazwaWłaściwości & ".xlsx"
Pozdrowienia
Witam
Jeśli chcesz również nadać swojemu plikowi Excela nieco układu, możesz dodać wiersze, takie jak na przykład:
NumCol = swBOMAnnotation.ColumnCount
NumRow = swBOMAnnotation.RowCount
xlApp.Worksheets(xlApp.ActiveSheet.Name).Rows(1).RowHeight = 40
For I = 1 To NumRow - 1
xlApp.Worksheets(xlApp.ActiveSheet.Name).Rows(I + 1).RowHeight = 20
Next I
For J = 0 To NumCol - 1
xlApp.Worksheets(xlApp.ActiveSheet.Name).Columns(J + 1).ColumnWidth = 25
xlApp.ActiveSheet.Cells(1, J + 1).Interior.ColorIndex = 15
Next J
For I = 0 To NumRow - 1
For J = 0 To NumCol - 1
xlApp.ActiveSheet.Cells(I + 1, J + 1).NumberFormat = "@"
xlApp.ActiveSheet.Cells(I + 1, J + 1).VerticalAlignment = 2
sht.Cells(I + 1, J + 1).Value = swBOMAnnotation.Text(I, J)
Next J
Next I
Zamiast:
NumCol = swBOMAnnotation.ColumnCount
NumRow = swBOMAnnotation.RowCount
For I = 0 To NumRow
For J = 0 To NumCol
sht.Cells(I + 1, J + 1).Value = swBOMAnnotation.Text(I, J)
Next J
Next I
Linia:
xlApp.ActiveSheet.Cells(I + 1, J + 1). NumberFormat = "@"
jest szczególnie interesujący, jeśli masz wartości liczbowe zaczynające się od 0, ponieważ umieszcza komórkę programu Excel w formacie tekstowym, a tym samym pozwala uniknąć utraty 0 na początku.
Pozdrowienia
Witam
Przede wszystkim dziękuję za udostępnienie, naprawdę wspaniale jest znaleźć tutaj informacje tej jakości!
Próbuję skonfigurować makro eksportu zestawienia komponentów; Niestety nie mogę go zmusić do działania.
Otrzymuję komunikat "Błąd wykonania 91 Zmienna obiektu lub zmienna blokowa z niezdefiniowaną" w następujących wierszach:
Ustaw swBOMAnnotation = swModelDocExt.InsertBomTable3(NazwaSzablonu, 0, 0, TypFormularza, Konfiguracja, Fałsz, swNumberingType_Detailed, Prawda)
Ustaw swBOMFeature = swBOMAnnotation.BomFeature
Czy masz jakiś pomysł, co może być problemem?
Z góry dzięki!
Witam
Zbieg okoliczności polega na tym, że pracuję nad automatycznym nazewnictwem i to makro pojawia się w samą porę. Mam tylko jeden problem, który polega na tym, że pobiera informacje o częściach pierwszego poziomu , a nie o częściach w zespole lub podzespole podzespołu zespołu itp.
Czy istnieje rozwiązanie?
Dziękuję
Niech moc będzie z wami.
Witaj OBI WAN,
Tak, istnieje rozwiązanie, zamieniasz wiersz "BomType = swBomType_TopLevelOnly" na "BomType = swBomType_Indented", co powinno umieścić nomenklaturę w wielopoziomowej.
Pozdrowienia
Witaj S.Descamps,
Czy ścieżka do szablonu zestawienia komponentów została poprawnie zastąpiona w wierszu "TemplateName = "Z:\Model_SW\Nomenclature.sldbomtbt"?
Lub nazwa konfiguracji z prawidłową konfiguracją w wierszu "Konfiguracja = "Domyślnie""?
Pozdrowienia
Witam
Myślę, że jest to związane z faktem, że plik znajduje się na starym adresie URL witryny. Nie jest bezpieczny, więc przeglądarka się zawiesza (przynajmniej tak się dzieje w domu)
Witam;
Nie mam żadnych problemów z pobraniem go (Firefox?), oto (znowu):
insert-bom-asm.swp (77,5 KB)
a jeśli to naprawdę nie działa, oto wersja " Maszynopis ":
Option Explicit
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 = "Z:\Model_SW\Nomenclature.sldbomtbt"
BomType = swBomType_TopLevelOnly
Configuration = "Défaut"
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
For J = 0 To NumCol
sht.Cells(I + 1, J + 1).Value = swBOMAnnotation.Text(I, J)
Next J
Next I
boolstatus = swModelDocExt.SelectByID2(swBOMFeature.GetFeature.Description, "BOMFEATURE", 0, 0, 0, True, 0, Nothing, 0)
swModel.EditDelete
swModel.ForceRebuild3 True
Dim config As SldWorks.Configuration
Dim cusPropMgr As SldWorks.CustomPropertyManager
Dim lRetVal As Long
Dim ValOut As String
Dim ResolvedValOut As String
Dim wasResolved As Boolean
Dim nNbrProps As Long
Dim vPropNames As Variant
Dim vPropTypes As Variant
Dim vPropValues As Variant
Dim resolved As Variant
Dim custPropType As Long
Dim K As Long
Dim NomProperty As String
Set config = swModel.GetActiveConfiguration
Set cusPropMgr = config.CustomPropertyManager
nNbrProps = cusPropMgr.Count
vPropNames = cusPropMgr.GetNames
For K = 0 To nNbrProps - 1
cusPropMgr.Get2 vPropNames(K), ValOut, ResolvedValOut
custPropType = cusPropMgr.GetType2(vPropNames(K))
If vPropNames(K) = "DESSINATEUR" Then
NomProperty = ResolvedValOut
End If
Next K
Dim chemin As String
chemin = Environ("USERPROFILE") & "\Desktop\" & swModel.GetTitle & "-" & NomProperty & ".xls"
With xlApp
wbk.SaveAs chemin
wbk.Close
.Quit
End With
End Sub
Pozdrowienia.
Witam
Na tym linku to działa. Na oryginalnym w Edge generuje błąd związany z bezpieczeństwem pobierania.
Cóż, to wszystko... Czy są ludzie, którzy używają " Edge "!!
Nie ma wyboru 