Makro wstaw CutList

Cze wszystkim

Chcę stworzyć makro VBA w SolidWorks, aby zautomatyzować aktualizację list wycięć w moich rysunkach.

Oto moje tło:

  • Często pracuję na podstawie już istniejących rysunków ze wszystkimi moimi widokami.
  • Gdy zastępuję odwołaną część inną, lista cięć nie jest automatycznie aktualizowana.

Mój cel z tym makro:

  1. Usuń wszystkie istniejące listy spaw z rysunku.
  2. Wstaw nową listę cięć na podstawie widoku 1 rysunku.
  3. Nowa tabela powinna idealnie używać konkretnego szablonu i szanować punkt kotwiczenia zdefiniowany w szablonie.

Próbowałem kilku podejść z InsertWeldmentTable, InsertWeldmentCutList lub InsertWeldmentTableAnnotation, ale zawsze napotykam błędy 438 lub 91, związane z wyborem widoku lub metodami niedostępnymi w VBA.

Czy ktoś mógłby pomóc mi znaleźć wiarygodną metodę w VBA , żeby:

  • Usuń stare listy cięć
  • Automatycznie wstaw nowy w widoku 1 z szablonowym punktem kotwiczenia

Z góry dziękuję za pomoc i rady! :wink:

Witam;

Dlaczego próbować wprowadzać tę aktualizację w rysunku, skoro Solidworks pozwala na to automatycznie w pokoju?
image
Aby być powiązanym z " automatyczną aktualizacją listy spawanych części" w ustawieniach właściwości Szablon Twoich rysunków:


=> To powinno zaoszczędzić ci makro...

W pomieszczeniu, aby sprawdzić 2 linie wskazane przez @Maclane za pomocą makro:

Option Explicit

Public swApp As SldWorks.SldWorks
Public swModel As SldWorks.ModelDoc2
Public swPart As SldWorks.PartDoc
Public swBodyFolder As SldWorks.BodyFolder
Public swFeat As SldWorks.Feature

Sub main()

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
If swModel.GetType() = swDocumentTypes_e.swDocASSEMBLY Or swModel.GetType() = swDocumentTypes_e.swDocDRAWING Then
Debug.Print "Ne fonctionne que sur une pièce"
Set swModel = Nothing
Set swApp = Nothing
Exit Sub
End If

Set swPart = swModel

Set swFeat = swPart.FirstFeature

While Not swFeat Is Nothing
'Debug.Print ""
'Debug.Print "Nom de l'élément : "; swFeat.Name
'Debug.Print "Type de l'élément : "; swFeat.GetTypeName2
If swFeat.GetTypeName2 = "SolidBodyFolder" Then
    Set swBodyFolder = swFeat.GetSpecificFeature2
    swBodyFolder.SetAutomaticCutList (True)
    swBodyFolder.SetAutomaticUpdate (True)
    swBodyFolder.UpdateCutList
    swBodyFolder.GetAutomaticUpdate
End If
Set swFeat = swFeat.GetNextFeature()
Wend

Set swBodyFolder = Nothing
Set swFeat = Nothing
Set swPart = Nothing
Set swModel = Nothing
Set swApp = Nothing
End Sub

1 polubienie