Makro usuwanie linii osi instalacji

Witam

Chcę zrobić makro, aby usunąć linie osi ze wszystkich rozwiniętych widoków w MEP, ze wszystkich kart

uważają, że jest bardziej czytelny bez linii osi

Znalazłem początek z tymi 2 elementami, które mają zostać usunięte

swSelCENTERMARKSYMS = 100  '  "CENTERMARKSYMS"
swSelCENTERLINES = 103     '  "LINIA ŚRODKOWA"

 

i

https://www.lynkoa.com//forum/solidworks/macro-selectionner-toute-les-ligne-existante-sur-une-vue

ale nie wiem, jak to wszystko poukładać we właściwej kolejności

 

jeśli ktoś ma pomysł

Dziękuję

POMOC

czy ktos wie, jak zaprogramować chociaż kawałek kodu

Lub w przypadku braku w pełni zautomatyzowanego makra mogę również wybrać widok instalacji, a makro usunie linie środkowe z otworów

Przykład rysunku?

Jaki jest burt do eksportu dxf bez linii osi?

Nie jest to możliwe poprzez zmianę planu tła lub standardu ubierania się posła do Parlamentu Europejskiego? Jeśli tak, być może możesz to zrobić bez większego wysiłku programistycznego dzięki narzędziu Integration (Visiativ (mycadtools), do którego masz dostęp jako subskrybent Mycadservice. A w tym celu infolinia może nawet Ci pomóc.

 

W przeciwnym razie, jeśli musisz zaprogramować, będziesz musiał dla swojego makra:

Pętla, która aktywuje każdy arkusz 1 na 1

że na każdym arkuszu otrzymujesz pierwszy aktywny widok, że sprawdzasz, czy nazwa konfiguracji części, do której się odwołujesz, to rzeczywiście płaski wzór.

Jeśli tak, wprowadzasz zmianę.

Zasadniczo nie jest to łatwe, jeśli nie masz pojęcia o programowaniu i nie ma kilku rzeczy, które ktoś zobaczy, że zdajesz sobie z tego sprawę w ciągu kilku sekund.

Chyba że masz kod, który jest wystarczająco blisko.

 

1 polubienie

Jest to kwestia usunięcia linii środkowych otworów tylko dla widoków rozwiniętych lub innych typów otworów, dla których Solidworks domyślnie wyświetla linie środkowe, nie mówię o liniach środkowych zgięć, chcę, aby linie środkowe otworów były automatyczne dla innych typów widoków

Linie te muszą zostać usunięte przed rozpoczęciem produkcji na maszynie do cięcia laserowego lub innej produkcji

Dla pętli na arkuszach:

https://help.solidworks.com/2021/English/api/sldworksapi/Get_Loaded_Sheets_Example_VB.htm

 

Witam

Spróbuj wykonać następujące czynności:

Option Explicit

Sub main()

    Dim swApp As SldWorks.SldWorks
    Dim swModel As SldWorks.ModelDoc2
    Dim swDrawing As SldWorks.DrawingDoc
    Dim vSheetName As Variant
    Dim swView As SldWorks.View
    Dim swCtrMark As SldWorks.CenterMark
    Dim swCtrLine As SldWorks.Centerline
    Dim swAnn As SldWorks.Annotation
    Dim swSelMgr As SldWorks.SelectionMgr
    Dim swSelData As SldWorks.SelectData
    Dim status As Boolean
    Dim bRet As Boolean
    Dim i As Long
    Dim SearchString As String
    Dim SearchChar As String
    Dim MyPos As Integer

    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swSelMgr = swModel.SelectionManager
    Set swSelData = swSelMgr.CreateSelectData
    Set swDrawing = swModel
    
    SearchChar = "SM-FLAT-PATTERN"
    
    vSheetName = swDrawing.GetSheetNames
    
    For i = 0 To UBound(vSheetName)
        bRet = swDrawing.ActivateSheet(vSheetName(i))
        
        Set swView = swDrawing.GetFirstView
        swModel.ClearSelection2 True
        Do While Not swView Is Nothing
            SearchString = swView.ReferencedConfiguration
            MyPos = InStr(1, SearchString, SearchChar)
            If MyPos <> 0 Then
                Set swCtrMark = swView.GetFirstCenterMark
                Do While Not swCtrMark Is Nothing
                    Set swAnn = swCtrMark.GetAnnotation
                    status = swAnn.Select3(True, swSelData)
                    Set swCtrMark = swCtrMark.GetNext
                Loop
            End If
            Set swView = swView.GetNextView
        Loop
        swModel.EditDelete
        
        Set swView = swDrawing.GetFirstView
        swModel.ClearSelection2 True
        Do While Not swView Is Nothing
            SearchString = swView.ReferencedConfiguration
            MyPos = InStr(1, SearchString, SearchChar)
            If MyPos <> 0 Then
                Set swCtrLine = swView.GetFirstCenterLine
                Do While Not swCtrLine Is Nothing
                    Set swAnn = swCtrLine.GetAnnotation
                    status = swAnn.Select3(True, swSelData)
                    Set swCtrLine = swCtrLine.GetNext
                Loop
            End If
            Set swView = swView.GetNextView
        Loop
        swModel.EditDelete
        
    Next i
    
End Sub

Pozdrowienia

1 polubienie

Wielkie podziękowania dla d.rogera, który po raz kolejny podejmuje wyzwanie, biorąc pod uwagę, ile razy dzięki Tobie na tym forum udzielono odpowiedzi na jedno z moich pytań, chylę czoła przed Tobą za dobrze napisane i zwięzłe makra

1 polubienie