MACRO: stel de standaardlaag van een tekening in op -Volgens de standaard-

Hallo allemaal!

Als onderdeel van een evolutie van SW-skinstandaarden in het bedrijf, realiseerde ik me dat het laden van een nieuwe skinstandaard niet betrouwbaar is: niet alle lagen zijn aanwezig en erger nog, de toewijzingen zijn niet altijd de juiste.

Ik moet dus veel dingen automatiseren:

  1. Controleer het bestaan van elke laag, anders maak je de ontbrekende lagen (sommige hebben aangepaste kleuren → moet de kleur instellen met de RGB-code

  2. Controleer de lagen die voor elk element zijn toegewezen (afmetingen, positielabel, middenas, doorsnede, enz.) in de documenteigenschappen

  3. Forceer de standaardlaag van het document op -Volgens de standaard- (bij het openen is de standaardlaag ingesteld op -Geen-, en ik wil deze wijzigen in -Volgens de standaard-).

  4. Wijs clipelementen opnieuw toe aan de juiste lagen

Ik begon met het laatste punt waarvoor ik al snel elementen vond die me op het forum konden helpen, maar ik zit toch vast:

Mijn code:

Dim swApp                       As SldWorks.SldWorks
Dim swModel                     As SldWorks.ModelDoc2
Dim swLayerMgr                  As SldWorks.LayerMgr
Dim vLayerArr                   As Variant
Dim vLayer                      As Variant
Dim swLayer                     As SldWorks.Layer
Dim swDraw                      As SldWorks.DrawingDoc
Dim vSheets                 As Variant
Dim vSheet                  As Variant
Dim swView                      As SldWorks.View               
Dim swAnn                       As SldWorks.Annotation          
Dim swNote                      As SldWorks.Note                
Dim swDispDim                   As SldWorks.DisplayDimension
Dim swGtol                      As SldWorks.Gtol                
Dim swDatum                     As SldWorks.DatumTag           
Dim swAnnSFSymbol               As SldWorks.SFSymbol           
Dim swAnnWeldSymbol             As SldWorks.WeldSymbol          
Dim swCtrMark                   As SldWorks.CenterMark          
Dim swCenterLine                As SldWorks.Centerline          
Dim swTables                As Variant
Dim swTable                 As Variant

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
If swModel Is Nothing Then
    MsgBox "Ouvrez et/ou activez une mise en plan."
    Exit Sub 
End If
If swModel.GetType <> swDocumentTypes_e.swDocDRAWING Then
    MsgBox "Ouvrez et/ou activez une mise en plan."
    Exit Sub 
End If

Set swDraw = swModel

vSheets = swDraw.GetSheetNames
For Each vSheet In vSheets
    swDraw.ActivateSheet vSheet

    Set swView = swDraw.GetFirstView

    Set swView = swView.GetNextView
    While Not swView Is Nothing

        Set swCtrMark = swView.GetFirstCenterMark
        While Not swCtrMark Is Nothing
            Set swAnn = swCtrMark.GetAnnotation
            swAnn.Layer = "Axes"
            Set swCtrMark = swCtrMark.GetNext
        Wend

        Set swCenterLine = swView.GetFirstCenterLine
        While Not swCenterLine Is Nothing
            Set swAnn = swCenterLine.GetAnnotation
            swAnn.Layer = "Axes"
            Set swCenterLine = swCenterLine.GetNext
        Wend

        Set swDatum = swView.GetFirstDatumTag
        While Not swDatum Is Nothing
            Set swAnn = swDatum.GetAnnotation
            swAnn.Layer = "Références"
            Set swDatum = swDatum.GetNext
        Wend

        Set swGtol = swView.GetFirstGTOL
        While Not swGtol Is Nothing
            Set swAnn = swGtol.GetAnnotation
            swAnn.Layer = "Cotes"
            Set swGtol = swGtol.GetNextGTOL
        Wend

        Set swAnnSFSymbol = swView.GetFirstSFSymbol
        While Not swAnnSFSymbol Is Nothing
            Set swAnn = swAnnSFSymbol.GetAnnotation
            swAnn.Layer = "État de surface"
            Set swAnnSFSymbol = swAnnSFSymbol.GetNext
        Wend

        Set swAnnWeldSymbol = swView.GetFirstWeldSymbol
        While Not swAnnWeldSymbol Is Nothing
            Set swAnn = swAnnWeldSymbol.GetAnnotation
            swAnn.Layer = "Soudures"
            Set swAnnWeldSymbol = swAnnWeldSymbol.GetNext
        Wend

        Set swDispDim = swView.GetFirstDisplayDimension5
        While Not swDispDim Is Nothing
            Set swAnn = swDispDim.GetAnnotation
            swAnn.Layer = "Cotes"
            Set swDispDim = swDispDim.GetNext5
        Wend

  
        Set swView = swView.GetNextView
    Wend
Next
swModel.ClearSelection2 True

Problemen /4:

  • Stel swNote in = swView.GetFirstNote stelt me in staat om de notities te selecteren die aan de weergaven zijn gekoppeld.
    Maar hoe selecteer je de notities die op hun beurt aan het blad zijn bevestigd?

  • Welke API om positielabels te selecteren?

  • Welke API('s) om de lijnen te selecteren en labels te snijden?

Problemen /3:

  • Ik heb het geprobeerd met swDraw.SetCurrentLayer("-Volgens de standaard-") maar -Volgens de standaard- niet echt een klap in het gezicht... Er gebeurt niets. Ik dacht dat het misschien was toegewezen aan de eerste index in de lagenlijst, maar swDraw.SetCurrentLayer(0) werkt ook niet.
    Heeft iemand een idee?

Voor de eerste 2 punten ben ik nog niet begonnen om ze te bekijken, maar als iemand elementen heeft of misschien zelfs de code waarmee je ze kunt maken, ben ik geïnteresseerd!

Bij voorbaat dank!

Hallo;
Om door alle notities te bladeren:
https://help.solidworks.com/2021/English/api/sldworksapi/Get_Views_and_Notes_Example_VB.htm

Aan de andere kant gebruik ik een macro voor tekeningen om de standaard EN de basiskaart opnieuw te laden, wat behoorlijk goede resultaten geeft...

Om geassocieerd te worden met een aandoening:
filetype = swModel.GetType ' Geeft het type document dat is geopend met:0=swDocNONE; 1=swDocDEEL; 2=swDocASSEMBLY; 3=swDocTEKENING
Als filetype = 3 Dan' Als het geopende bestand een tekening is

Dim vSheetProps     As Variant
Dim nErrors         As Long
Dim nTemplatePath   As String
Dim swPaperWidth    As String
Dim swPaperHeight   As String


' Repertoire contenant les modeles des fonds de plans
Const sTemplatePath As String = "W:\Modeles_solidworks\Fonds_de_plans_2023" 'A ADAPTER :EMPLACEMENT DE VOS FOND DE PLAN PERSONNALISE

' Formats des differents fond de plans disponibles dans le Repertoire ci-dessous

Const A0HTemplateName As String = "A0H PERSO 2023.slddrt" 'A ADAPTER : VOTRE FOND DE PLAN PERSONNALISE
Const A1HTemplateName As String = "A1H PERSO 2023.slddrt"
Const A1VTemplateName As String = "A1V PERSO 2023.slddrt"
Const A2HTemplateName As String = "A2H PERSO 2023.slddrt"
Const A2VTemplateName As String = "A2V PERSO 2023.slddrt"
Const A3HTemplateName As String = "A3H PERSO 2023.slddrt"
Const A3VTemplateName As String = "A3V PERSO 2023.slddrt"
Const A4HTemplateName As String = "A4H PERSO 2023.slddrt"
Const A4VTemplateName As String = "A4V PERSO 2023.slddrt"

Sub Formats()

 Dim swApp As SldWorks.SldWorks
    Dim swModel As SldWorks.ModelDoc2
    Dim swDraw As SldWorks.DrawingDoc
    Dim swSheet As SldWorks.Sheet
    Dim vSheetProps As Variant
   

    Set swApp = Application.SldWorks
    Set swModel = swApp.ActiveDoc
    Set swDraw = swModel
    Set swSheet = swDraw.GetCurrentSheet
    

        'swModel.ActivateSheet vSheetName
            Set swSheet = swModel.GetCurrentSheet
            vSheetProps = swSheet.GetProperties
            swPaperWidth = vSheetProps(5)
            swPaperHeight = vSheetProps(6)
        Select Case swPaperWidth & swPaperHeight ' Comparaison de la Longueur et de la Largeur du fond de plan present (Unité en Metres)
        
Case "1,189" & "0,841" ' Format A0H
        nTemplatePath = sTemplatePath & "\" & A0HTemplateName
        boolstatus = swModel.Extension.LoadDraftingStandard("W:\Modeles_solidworks\Normes_de_mise_en_plans\ISO-PERSO_A0.sldstd")
       
Case "0,841" & "0,594" ' Format A1H
        nTemplatePath = sTemplatePath & "\" & A1HTemplateName
        boolstatus = swModel.Extension.LoadDraftingStandard("W:\Modeles_solidworks\Normes_de_mise_en_plans\ISO-PERSO_A1.sldstd")
        
Case "0,594" & "0,841" ' Format A1V
        nTemplatePath = sTemplatePath & "\" & A1VTemplateName
        boolstatus = swModel.Extension.LoadDraftingStandard("W:\Modeles_solidworks\Normes_de_mise_en_plans\ISO-PERSO_A1.sldstd")

Case "0,594" & "0,42" ' Format A2H
        nTemplatePath = sTemplatePath & "\" & A2HTemplateName
        boolstatus = swModel.Extension.LoadDraftingStandard("W:\Modeles_solidworks\Normes_de_mise_en_plans\ISO-PERSO_A2.sldstd")

Case "0,42" & "0,594" ' Format A2V
        nTemplatePath = sTemplatePath & "\" & A2VTemplateName
        boolstatus = swModel.Extension.LoadDraftingStandard("W:\Modeles_solidworks\Normes_de_mise_en_plans\ISO-PERSO_A2.sldstd")

Case "0,42" & "0,297" ' Format A3H
        nTemplatePath = sTemplatePath & "\" & A3HTemplateName
        boolstatus = swModel.Extension.LoadDraftingStandard("W:\Modeles_solidworks\Normes_de_mise_en_plans\ISO-PERSO_A3.sldstd")

Case "0,297" & "0,42" ' Format A3V
        nTemplatePath = sTemplatePath & "\" & A3VTemplateName
        boolstatus = swModel.Extension.LoadDraftingStandard("W:\Modeles_solidworks\Normes_de_mise_en_plans\ISO-PERSO_A3.sldstd")

Case "0,297" & "0,21" ' Format A4H
        nTemplatePath = sTemplatePath & "\" & A4HTemplateName
        boolstatus = swModel.Extension.LoadDraftingStandard("W:\Modeles_solidworks\Normes_de_mise_en_plans\ISO-PERSO_A4.sldstd")

Case "0,21" & "0,297" ' Format A4V
        nTemplatePath = sTemplatePath & "\" & A4VTemplateName
        boolstatus = swModel.Extension.LoadDraftingStandard("W:\Modeles_solidworks\Normes_de_mise_en_plans\ISO-PERSO_A4.sldstd")

        Case Else
        nTemplatePath = sTemplatePath & "\" & A2HTemplateName 'Format par défaut si le fond de plan present n'est pas dans la liste ci-dessus
        boolstatus = swModel.Extension.LoadDraftingStandard("W:\Modeles_solidworks\Normes_de_mise_en_plans\ISO-PERSO_A2.sldstd")
        
End Select
        
   'On Supprime le fond de plan initial
    swModel.SetupSheet5 swSheet.GetName, swDwgPapersUserDefined, swDwgTemplateNone, vSheetProps(2), vSheetProps(3), vSheetProps(4), "", vSheetProps(5), vSheetProps(6), "Default", True
    
    'On Recharge le nouveau fond de plan
    swModel.SetupSheet5 swSheet.GetName, swDwgPapersUserDefined, swDwgTemplateCustom, vSheetProps(2), vSheetProps(3), vSheetProps(4), nTemplatePath, vSheetProps(5), vSheetProps(6), "Default", True
    
 Call table_rev
        
    swModel.ViewZoomtofit2
    
End Sub

2 likes

Hallo

Zelfde antwoord als @Maclane.
Om duidelijk te antwoorden,

Het is niet nodig om lagen toe te voegen en in te stellen, ontbrekende lagen met hun kleurinstellingen worden geïmporteerd bij het wijzigen van de achtergrond. Aan de andere kant, als er lagen met dezelfde namen zijn die zijn gewijzigd in hun kleurinstelling, moet u de kleur instellen.
Een ander punt, als er meer lagen in de oude lagen zijn, moet je ze ook opschonen en kijken of je wat erop zou staan naar een andere laag moet overbrengen voordat je de laag verwijdert.
Wat weergavelabels en snijlijnen betreft, zodra u de terugloopstandaard wijzigt, is deze van toepassing op het document zonder dat u de objecten hoeft te selecteren.

Eindelijk heb ik een stukje code dat een beetje van dit alles doet. Ik heb ook nog een stuk code waarmee je alle soorten objecten kunt scannen en waarschijnlijk hun laag kunt ophalen (ik gebruik het daar in de eerste plaats niet voor).
De @Maclane code is al een goed begin.
In uw code, om de basiskaart te scannen, moet u in de eerste " lus " blijven met betrekking tot:

Set swView = swDraw.GetFirstView

Kortom, deze regel code is om de achtergrond van het plan in te voeren, als je net als laatste Set swView = swView.GetNextView schrijft, ga je naar de scan van de weergaven van het plan.
Je moet dus een lus maken in de basiskaart om alles wat er is te herstellen en de gewenste behandeling toe te passen.
Om van toepassing te zijn op de " Volgens de standaard " laag, ik heb geen methode gezien in de API en het lijkt mij dat het op de 2022 een beetje bugt (een ander geheugenonderwerp op het forum in handmatige toepassing Edit: De laag terugplaatsen/opnieuw activeren " Volgens de standaard " - 2D-plan / tekening - myCAD-forum (visiativ.com)).

2 likes

Re, niet-geteste code, maar zou het werk moeten doen denk ik:

Dim swApp                       As SldWorks.SldWorks
Dim swModel                     As SldWorks.ModelDoc2
Dim swLayerMgr                  As SldWorks.LayerMgr
Dim vLayerArr                   As Variant
Dim vLayer                      As Variant
Dim swLayer                     As SldWorks.Layer
Dim swDraw                      As SldWorks.DrawingDoc
Dim vSheets                     As Variant
Dim vSheet                      As Variant
Dim swView                      As SldWorks.View
Dim swAnn                       As SldWorks.Annotation
Dim swNote                      As SldWorks.Note
Dim swTables                    As Variant
Dim swTable                     As Variant
Dim vSheetProps                 As Variant
Dim nErrors                     As Long
Dim nTemplatePath               As String
Dim swPaperWidth                As String
Dim swPaperHeight               As String
Dim Count                       As Integer
Dim i                           As Long
Dim j                           As Long

' Repertoire contenant les modeles des fonds de plans
Const sTemplatePath As String = "W:\Modeles_solidworks\Fonds_de_plans_2023" 'A ADAPTER :EMPLACEMENT DE VOS FOND DE PLAN PERSONNALISE

' Formats des differents fond de plans disponibles dans le Repertoire ci-dessous

Const A0HTemplateName As String = "A0H PERSO 2023.slddrt" 'A ADAPTER : VOTRE FOND DE PLAN PERSONNALISE
Const A1HTemplateName As String = "A1H PERSO 2023.slddrt"
Const A1VTemplateName As String = "A1V PERSO 2023.slddrt"
Const A2HTemplateName As String = "A2H PERSO 2023.slddrt"
Const A2VTemplateName As String = "A2V PERSO 2023.slddrt"
Const A3HTemplateName As String = "A3H PERSO 2023.slddrt"
Const A3VTemplateName As String = "A3V PERSO 2023.slddrt"
Const A4HTemplateName As String = "A4H PERSO 2023.slddrt"
Const A4VTemplateName As String = "A4V PERSO 2023.slddrt"

Sub Main()
Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
If swModel Is Nothing Then
    MsgBox "Ouvrez et/ou activez une mise en plan."
    Exit Sub
End If
If swModel.GetType <> swDocumentTypes_e.swDocDRAWING Then
    MsgBox "Ouvrez et/ou activez une mise en plan."
    Exit Sub
End If

Set swDraw = swModel
If swDraw.GetSheetCount > 1 Then
    vSheets = swDraw.GetSheetNames
    For j = 0 To UBound(vSheets)
        boolstatus = swDraw.ActivateSheet(vSheets(j))
        Call ChangeSheetFormat
        ProcessDrawing swApp, swDraw
        Call PurgeCalques
    Next j
    boolstatus = swDraw.ActivateSheet(vSheets(0))
Else
    Call ChangeSheetFormat
    ProcessDrawing swApp, swDraw
    Call PurgeCalques
End If
End Sub

Sub ChangeSheetFormat()
   
Set swSheet = swDraw.GetCurrentSheet
vSheetProps = swSheet.GetProperties
swPaperWidth = vSheetProps(5)
swPaperHeight = vSheetProps(6)
Select Case swPaperWidth & swPaperHeight ' Comparaison de la Longueur et de la Largeur du fond de plan present (Unité en Metres)
       
Case "1,189" & "0,841" ' Format A0H
       nTemplatePath = sTemplatePath & "\" & A0HTemplateName
       boolstatus = swModel.Extension.LoadDraftingStandard("W:\Modeles_solidworks\Normes_de_mise_en_plans\ISO-PERSO_A0.sldstd")
      
Case "0,841" & "0,594" ' Format A1H
       nTemplatePath = sTemplatePath & "\" & A1HTemplateName
       boolstatus = swModel.Extension.LoadDraftingStandard("W:\Modeles_solidworks\Normes_de_mise_en_plans\ISO-PERSO_A1.sldstd")
       
Case "0,594" & "0,841" ' Format A1V
       nTemplatePath = sTemplatePath & "\" & A1VTemplateName
       boolstatus = swModel.Extension.LoadDraftingStandard("W:\Modeles_solidworks\Normes_de_mise_en_plans\ISO-PERSO_A1.sldstd")

Case "0,594" & "0,42" ' Format A2H
       nTemplatePath = sTemplatePath & "\" & A2HTemplateName
       boolstatus = swModel.Extension.LoadDraftingStandard("W:\Modeles_solidworks\Normes_de_mise_en_plans\ISO-PERSO_A2.sldstd")

Case "0,42" & "0,594" ' Format A2V
       nTemplatePath = sTemplatePath & "\" & A2VTemplateName
       boolstatus = swModel.Extension.LoadDraftingStandard("W:\Modeles_solidworks\Normes_de_mise_en_plans\ISO-PERSO_A2.sldstd")

Case "0,42" & "0,297" ' Format A3H
       nTemplatePath = sTemplatePath & "\" & A3HTemplateName
       boolstatus = swModel.Extension.LoadDraftingStandard("W:\Modeles_solidworks\Normes_de_mise_en_plans\ISO-PERSO_A3.sldstd")

Case "0,297" & "0,42" ' Format A3V
       nTemplatePath = sTemplatePath & "\" & A3VTemplateName
       boolstatus = swModel.Extension.LoadDraftingStandard("W:\Modeles_solidworks\Normes_de_mise_en_plans\ISO-PERSO_A3.sldstd")

Case "0,297" & "0,21" ' Format A4H
       nTemplatePath = sTemplatePath & "\" & A4HTemplateName
       boolstatus = swModel.Extension.LoadDraftingStandard("W:\Modeles_solidworks\Normes_de_mise_en_plans\ISO-PERSO_A4.sldstd")

Case "0,21" & "0,297" ' Format A4V
       nTemplatePath = sTemplatePath & "\" & A4VTemplateName
       boolstatus = swModel.Extension.LoadDraftingStandard("W:\Modeles_solidworks\Normes_de_mise_en_plans\ISO-PERSO_A4.sldstd")

       Case Else
       nTemplatePath = sTemplatePath & "\" & A2HTemplateName 'Format par défaut si le fond de plan present n'est pas dans la liste ci-dessus
       boolstatus = swModel.Extension.LoadDraftingStandard("W:\Modeles_solidworks\Normes_de_mise_en_plans\ISO-PERSO_A2.sldstd")
       
End Select
       
  'On Supprime le fond de plan initial
   swModel.SetupSheet5 swSheet.GetName, swDwgPapersUserDefined, swDwgTemplateNone, vSheetProps(2), vSheetProps(3), vSheetProps(4), "", vSheetProps(5), vSheetProps(6), "Default", True
   
   'On Recharge le nouveau fond de plan
   swModel.SetupSheet5 swSheet.GetName, swDwgPapersUserDefined, swDwgTemplateCustom, vSheetProps(2), vSheetProps(3), vSheetProps(4), nTemplatePath, vSheetProps(5), vSheetProps(6), "Default", True
   
swModel.ForceRebuild3 (False)
swModel.ViewZoomtofit2
   
End Sub
Sub ProcessDrawing(swApp As SldWorks.SldWorks, swDraw As SldWorks.DrawingDoc)

    Set swView = swDraw.GetFirstView
    Do While Not Nothing Is swView
        Set swAnn = swView.GetFirstAnnotation3
        Do While Not Nothing Is swAnn
            ProcessAnnotation swApp, swAnn
            Set swAnn = swAnn.GetNext3
        Loop
        Set swView = swView.GetNextView
    Loop
End Sub
Sub ProcessAnnotation(swApp As SldWorks.SldWorks, swAnn As SldWorks.Annotation)
    Dim swAnnCThread                As SldWorks.CThread
    Dim swAnnDatumTag               As SldWorks.DatumTag
    Dim swAnnDatumTargetSym         As SldWorks.DatumTargetSym
    Dim swAnnDisplayDimension       As SldWorks.DisplayDimension
    Dim swAnnGTol                   As SldWorks.Gtol
    Dim swAnnNote                   As SldWorks.Note
    Dim swAnnSFSymbol               As SldWorks.SFSymbol
    Dim swAnnWeldSymbol             As SldWorks.WeldSymbol
    Dim swAnnCustomSymbol           As SldWorks.CustomSymbol
    Dim swAnnDowelSym               As SldWorks.DowelSymbol
    Dim swAnnLeader                 As SldWorks.MultiJogLeader
    Dim swAnnCenterMarkSym          As SldWorks.CenterMark
    Dim swAnnTable                  As SldWorks.TableAnnotation
    Dim swAnnCenterLine             As SldWorks.Centerline
    Dim swAnnDatumOrigin            As SldWorks.DatumOrigin
    Dim swDim                       As SldWorks.Dimension
    Dim swDimensionTolerance        As SldWorks.DimensionTolerance
    Dim idx                         As Long
    Dim params                      As Variant
    Dim arrSymbols                  As Variant
    Dim nNumCol                     As Long
    Dim nNumRow                     As Long
    Dim sTableText                  As String
    Dim sSurface                    As String
    Dim sIsIndNote                  As String
    Dim j                           As Long
    Dim sGtol                       As String
    Dim sWeldNote                   As String
    Dim TableAnchor                 As TableAnchor
    
   
    Select Case swAnn.GetType
        Case swCenterMarkSym
            Set swAnn = swAnnCenterMarkSym.GetAnnotation
            swAnn.Layer = "Axes"
        Case swCenterLine
            Set swAnn = swAnnCenterLine.GetAnnotation
            swAnn.Layer = "Axes"
        Case swDatumTag
            Set swAnn = swAnnDatumTag.GetAnnotation
            swAnn.Layer = "Références"
        Case swDisplayDimension
            Set swAnn = swDispDim.GetAnnotation
            swAnn.Layer = "Cotes"
        Case swGtol
            Set swAnn = swAnnGTol.GetAnnotation
            swAnn.Layer = "Cotes"
        Case swSFSymbol
            Set swAnn = swAnnSFSymbol.GetAnnotation
            swAnn.Layer = "État de surface"
        Case swWeldSymbol
            Set swAnn = swAnnWeldSymbol.GetAnnotation
            swAnn.Layer = "Soudures"
    End Select
End Sub
Sub PurgeCalques()

Count = swLayerMgr.GetCount
vLayer = swLayerMgr.GetLayerList
For i = 0 To Count - 1
If vLayer(i) = "CARTOUCHE" Or _
vLayer(i) = "TEXTE FIXE CARTOUCHE" Or _
vLayer(i) = "Champs paramétrés" Or _
vLayer(i) = "cotation cartouche" Or _
vLayer(i) = "Consultation" Or _
vLayer(i) = "Cartouche de signature" Or _
vLayer(i) = "Indice()" Then
Else
swLayerMgr.DeleteLayer (vLayer(i))
End If
Next i
End Sub

2 likes

Dank u voor uw antwoorden. Je uitleg heeft me geholpen een paar dingen beter te begrijpen.

Het automatisch herladen van de basiskaart telkens wanneer een tekeningdocument wordt geopend in bewerking is al lang aanwezig in het bedrijf (een add-on ontwikkeld door de IT-dienst), maar ik ben geen fan en de fabrikanten ook niet: het reset de ankerpunten. En om de een of andere reden heb ik altijd een laag die vergeten is in alle lagen in het nieuwe documentsjabloon (.drwdot en .slddrt), en niet altijd dezelfde! Vandaar mijn behoefte om het bestaan van elke laag te controleren...

Als de objecten zijn gemaakt in de laag " -Geen- ", heeft het wijzigen van de terugloopstandaard geen invloed op objecten; daarom heb ik een code nodig om de objecten te verwerken, en vooral om de standaardlaag te kunnen herdefiniëren naar " -Volgens de standaard " maar voor dit laatste punt kon ik niets vinden.

Ik ben erin geslaagd om specifiek met de positielabels om te gaan door de bubbelstijl te controleren:

        Set swNote = swView.GetFirstNote
        While Not swNote Is Nothing
            Set swAnn = swNote.GetAnnotation
            If swAnn.GetSpecificAnnotation.GetBalloonStyle = swBS_SplitCirc Then swAnn.Layer = "Vues dérivées"                    
            Set swNote = swNote.GetNext
        Wend

Ik denk ook dat ik heb ontdekt hoe ik moet omgaan met snijlijnen en onderbroken zichtlijnen...

1 like

Hallo

Ik heb het codefragment weggelaten dat de snij-instellingen bijwerkt...
Ik zit in de fase van de prestatietest op mijn werkstation, zodra ik mijn hand terug krijg, maak ik het stukje code beschikbaar

Als het helpt, enkele van de instellingen die moeten worden bijgewerkt in het documentsjabloon:

Sub ParamDraw()

'Paramètres vues en coupe
If swModelDocExt.GetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swDetailingSectionViewLineStyleDisplay, _
swUserPreferenceOption_e.swDetailingNoOptionSpecified) <> 0 Then
    bRet = swModelDocExt.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swDetailingSectionViewLineStyleDisplay, _
    swUserPreferenceOption_e.swDetailingNoOptionSpecified, 0)
End If

bRet = swModelDocExt.GetUserPreferenceToggle(swUserPreferenceToggle_e.swDetailingSectionViewLabels_PerStandard, _
swUserPreferenceOption_e.swDetailingNoOptionSpecified)
If bRet Then
    bRet = swModelDocExt.SetUserPreferenceToggle(swUserPreferenceToggle_e.swDetailingSectionViewLabels_PerStandard, _
    swUserPreferenceOption_e.swDetailingNoOptionSpecified, False)
End If
     
If swModelDocExt.GetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swDetailingSectionViewLabels_Name, swUserPreferenceOption_e.swDetailingNoOptionSpecified) <> swDetailingViewLabelsName_none Then
    bRet = swModelDocExt.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swDetailingSectionViewLabels_Name, swUserPreferenceOption_e.swDetailingNoOptionSpecified, swDetailingViewLabelsName_none)
End If
    
If swModelDocExt.GetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swDetailingSectionViewLabels_Scale, swUserPreferenceOption_e.swDetailingNoOptionSpecified) <> 3 Then
    bRet = swModelDocExt.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swDetailingSectionViewLabels_Scale, swUserPreferenceOption_e.swDetailingNoOptionSpecified, 3)
    bRet = swModelDocExt.SetUserPreferenceString(swUserPreferenceStringValue_e.swDetailingSectionViewLabels_CustomScale, swUserPreferenceOption_e.swDetailingSectionView, "SCALE")
End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'Paramètres vues de détail

bRet = swModelDocExt.GetUserPreferenceToggle(swUserPreferenceToggle_e.swDetailingDetailViewLabels_PerStandard, _
swUserPreferenceOption_e.swDetailingDetailView)
If bRet Then
    bRet = swModelDocExt.SetUserPreferenceToggle(swUserPreferenceToggle_e.swDetailingDetailViewLabels_PerStandard, _
swUserPreferenceOption_e.swDetailingDetailView, False)
End If
     
If swModelDocExt.GetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swDetailingDetailViewLabels_Name, swUserPreferenceOption_e.swDetailingDetailView) <> swDetailingViewLabelsName_custom Then
    bRet = swModelDocExt.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swDetailingDetailViewLabels_Name, swUserPreferenceOption_e.swDetailingDetailView, swDetailingViewLabelsName_e.swDetailingViewLabelsName_custom)
    bRet = swModelDocExt.SetUserPreferenceString(swUserPreferenceStringValue_e.swDetailingDetailViewLabels_CustomName, swUserPreferenceOption_e.swDetailingDetailView, "DETAIL")
End If
    
If swModelDocExt.GetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swDetailingDetailViewLabels_Scale, swUserPreferenceOption_e.swDetailingDetailView) <> 3 Then
    bRet = swModelDocExt.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swDetailingDetailViewLabels_Scale, swUserPreferenceOption_e.swDetailingDetailView, swDetailingViewLabelsScale_e.swDetailingViewLabelsScale_SCALEcustom)
    bRet = swModelDocExt.SetUserPreferenceString(swUserPreferenceStringValue_e.swDetailingDetailViewLabels_CustomScale, swUserPreferenceOption_e.swDetailingDetailView, "SCALE")
End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'Paramètres vues auxiliaires

bRet = swModelDocExt.GetUserPreferenceToggle(swUserPreferenceToggle_e.swDetailingAuxViewLabels_PerStandard, _
swUserPreferenceOption_e.swDetailingNoOptionSpecified)
If bRet Then
    bRet = swModelDocExt.SetUserPreferenceToggle(swUserPreferenceToggle_e.swDetailingAuxViewLabels_PerStandard, _
swUserPreferenceOption_e.swDetailingNoOptionSpecified, False)
End If
     
If swModelDocExt.GetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swDetailingAuxViewLabels_Name, swUserPreferenceOption_e.swDetailingNoOptionSpecified) <> swDetailingViewLabelsName_custom Then
    bRet = swModelDocExt.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swDetailingAuxViewLabels_Name, swUserPreferenceOption_e.swDetailingNoOptionSpecified, swDetailingViewLabelsName_e.swDetailingViewLabelsName_custom)
    bRet = swModelDocExt.SetUserPreferenceString(swUserPreferenceStringValue_e.swDetailingAuxViewLabels_CustomName, swUserPreferenceOption_e.swDetailingAuxiliaryView, "VIEW")
End If
    
If swModelDocExt.GetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swDetailingAuxViewLabels_Scale, swUserPreferenceOption_e.swDetailingNoOptionSpecified) <> 3 Then
    bRet = swModelDocExt.SetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swDetailingAuxViewLabels_Scale, swUserPreferenceOption_e.swDetailingNoOptionSpecified, swDetailingViewLabelsScale_e.swDetailingViewLabelsScale_SCALEcustom)
    bRet = swModelDocExt.SetUserPreferenceString(swUserPreferenceStringValue_e.swDetailingAuxViewLabels_CustomScale, swUserPreferenceOption_e.swDetailingAuxiliaryView, "SCALE")
End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'Paramètre mise à jour auto nomenclature

bRet = swModelDocExt.GetUserPreferenceToggle(swUserPreferenceToggle_e.swDetailingAutoUpdateBOM, swUserPreferenceOption_e.swDetailingNoOptionSpecified)
If bRet = False Then
    bRet = swModelDocExt.SetUserPreferenceToggle(swUserPreferenceToggle_e.swDetailingAutoUpdateBOM, swUserPreferenceOption_e.swDetailingNoOptionSpecified, True)
End If

End Sub

Om de snijlijnen te verwerken heb ik deze code geschreven:

Dim swApp                       As SldWorks.SldWorks
Dim swModel                     As SldWorks.ModelDoc2
Dim vSheets                 As Variant
Dim vSheet                  As Variant
Dim swView                      As SldWorks.View 
Dim swSectionLines            As Variant
Dim swSectionLine             As Variant
Dim swSectionLineAnn              As SldWorks.DrSection

Set swApp = Application.SldWorks
Set swModel = swApp.ActiveDoc
If swModel Is Nothing Then
    MsgBox "Ouvrez et/ou activez une mise en plan."
    Exit Sub
End If
If swModel.GetType <> swDocumentTypes_e.swDocDRAWING Then
    MsgBox "Ouvrez et/ou activez une mise en plan."
    Exit Sub
End If

Set swDraw = swModel
vSheets = swDraw.GetSheetNames
For Each vSheet In vSheets
    swDraw.ActivateSheet vSheet

    Set swView = swDraw.GetFirstView 
While Not swView Is Nothing
    
If swView.GetSectionLineCount2(1) > 0 Then
    Set swSectionLines = swView.GetSectionLines
        For Each swSectionLine In swSectionLines
            Set swBreakLineAnn = swSectionLine
            swSectionLineAnn.Layer = "Vues dérivées"
        Next
    Else: End If
        Set swView = swView.GetNextView
    Wend
Next
swModel.ClearSelection2 True

Maar het werkt niet. Ik heb de foutmelding 'Type komt niet overeen' aan

    Set swSectionLines = swView.GetSectionLines

Wie heeft een idee?

Ik had geen tijd om in detail te kijken en ik betwijfel of ik deze week tijd zal hebben, maar ik heb de indruk dat er geen mogelijkheid is om een set te maken om de laag op deze functie te wijzigen.
Voor het incompatibiliteitsprobleem zelf denk ik dat er parameters of functies ontbreken die eerder moeten worden aangeroepen (GetSectionLineInfo bijvoorbeeld).

1 like

Dus ik was in staat om door de snijlijnen en detailweergaven te komen.

Mijn code:


Function ChangeLayer(TypeElement As Integer)
    Dim swApp                       As SldWorks.SldWorks
    Dim swModel                     As SldWorks.ModelDoc2
    Dim swLayerMgr                  As SldWorks.LayerMgr
    Dim vLayerArr                   As Variant
    Dim vLayer                      As Variant
    Dim swLayer                     As SldWorks.Layer
    Dim swDraw                      As SldWorks.DrawingDoc
    Dim vSheets                 As Variant
    Dim vSheet                  As Variant
    Dim MySheet                 As Variant
    Dim swSheet                     As SldWorks.Sheet
    Dim swView                      As SldWorks.View                '//vue de mise en plan//'
    Dim vSectionLines           As Variant
    Dim vSectionLine            As Variant
    Dim swSectionLine              As SldWorks.DrSection
    Dim vDetailCircles            As Variant
    Dim vDetailCircle             As Variant
    Dim swDetailCircle                As SldWorks.DetailCircle
    Dim ret                     As Boolean

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

  
    Set swDraw = swApp.ActiveDoc
    vSheets = swDraw.GetSheetNames
    For Each vSheet In vSheets
        swDraw.ActivateSheet vSheet                                 '//Pour chaque feuille de la mise en plan//'
        Set swView = swDraw.GetFirstView '//la feuille (fond de plan inclu)//'
        Set swView = swView.GetNextView '//la première vue//'

                    '//Traitement des vues de détail//'
                    vDetailCircles = swView.GetDetailCircles
                    If Not IsEmpty(vDetailCircles) Then
                        For Each vDetailCircle In vDetailCircles
                            Set swDetailCircle = vDetailCircle
                            swDetailCircle.Layer = "VUE DÉRIVÉE"
                        Next
                    End If

                    '//Traitement des vues en coupe//'
                    vSectionLines = swView.GetSectionLines
                    If Not IsEmpty(vSectionLines) Then
                        For Each vSectionLine In vSectionLines
                            Set swSectionLine = vSectionLine
                            swSectionLine.Layer = "COUPE"
                        Next
                    End If
                    '//Reconstruit affichage de la vue//'
                    ret = swDraw.Rebuild(swRebuildOptions_e.swCurrentSheetDisp)
 Set swView = swView.GetNextView
            Wend
    Next
    swModel.ClearSelection2 True
    swModel.ViewZoomtofit2          '//zoom au mieux sur la feuille//'
    
End Function

En ik had helaas de bevestiging dat het niet mogelijk is om de standaardlaag van een document op -Volgens de standaard- te zetten omdat er geen API beschikbaar is. - Ik zal het afhandelen!

Mijn probleem is nu dat ik verschillende skin-standaarden moet beheren, en ik moet bepalen welke geladen is om al dan niet een laag aan de verschillende elementen toe te wijzen.

Als iemand dit stukje code al heeft, ben ik er helemaal voor!

Hallo
Je hebt dit stukje code nodig:

Dim vDSNames                As Variant
Dim swModelDocExt           As ModelDocExtension

Set swModelDocExt = swModel.Extension
vDSNames = swModelDocExt.GetDraftingStandardNames

VDSNames bevat alle skinstandaarden die beschikbaar zijn in het vervolgkeuzemenu.
Om erachter te komen welke wordt toegepast:

Dim sNorm as String
sNorm = swModelDocExt.GetUserPreferenceString(SwConst.swDetailingDimensionStandardName, SwConst.swDetailingNoOptionSpecified)

En tot slot om een nieuw model toe te passen:

bRet = swModelDocExt.LoadDraftingStandard("xxx") 'Mettre le nom de la norme d'habillage souhaitée
2 likes

Een grote dank aan u @Cyril_f en @Maclane !
Met jouw hulp kom ik aan het einde van wat ik moet doen.

Aan de top!

2 likes