Forum:SolidWorks
Thema:Pr��fma��e, Pr��ftabelle
Möchten Sie sich registrieren?
Wer darf antworten? Registrierte Benutzer können Beiträge verfassen.
Hinweise zur Registrierung Sie müssen registriert sein, um Beiträge oder Antworten auf Beiträge schreiben zu können.
Ihr Benutzername:
Ihr Kennwort:   Kennwort vergessen?
Anhang:    Datei(en) anhängen  <?>   Anhänge bearbeiten  <?>
Grafik für den Beitrag:                                                
                                                       
Ihre Antwort:

Fachbegriff
URL
Email
Fett
Kursiv
Durchgestr.
Liste
*
Bild
Zitat
Code

*HTML ist AUS
*UBB-Code ist AN
Smilies Legende
Netiquette

10 20 40

Optionen Smilies in diesem Beitrag deaktivieren.
Signatur anfügen: die Sie bei den Voreinstellungen angegeben haben.

Wenn Sie bereits registriert sind, aber Ihr Kennwort vergessen haben, klicken Sie bitte hier.

Bitte drücken Sie nicht mehrfach auf "Antwort speichern".

*Ist HTML- und/oder UBB-Code aktiviert, dann können Sie HTML und/oder UBB Code in Ihrem Beitrag verwenden.

T H E M A     A N S E H E N
CAD-Maler

Beiträge: 522 / 221

SWX 2015 SP5
AutoCAD 2015
Win 8.1 64 bit
Intel Xeon 3,2GHz
16GB RAM
Nvidia Quadro K2200
SWx EPDM

Da ich zufällig grade was gebastelt habe, lass ich euch direkt mal teilhaben.

Das Makro fügt die VorlageTabelle (Pfad anpassen!) unten links ein (falls der Verankerungspunkt für allg. Tabellen im Blattformat eingestellt ist, das false bei InsertTableAnnotation2 auf true ändern). Danach geht das alle Ansichten und alle Maße durch und wirft die Prüfmaße in die Tabelle. Anschließend wird vor das jew. Maß noch die laufende Nr. gesetzt.

Es werden nur Bemaßungen geprüft, keine Form- und Lagetoleranzen.

HTH.

Gruß, Jens

Code:

Dim swApp As Object
Dim Part As Object
Dim Gtol As Object
Dim FeatureData As Object
Dim Feature As Object
Dim Component As Object
Dim view As Object
Dim DisplayDimension As Object
Dim Dimension As Object
Dim Wert As Double
Dim tol As Variant
Dim dimstring As String
Dim myTable As Object
Dim myTextFormat As Object
Dim Präfix As String

Sub main()

Set swApp = Application.SldWorks
Set Part = swApp.ActiveDoc

'Schrifthöhe für allg. Tabellen auf 2.5 setzen
Set myTextFormat = Part.Extension.GetUserPreferenceTextFormat(swUserPreferenceTextFormat_e.swDetailingGeneralTableTextFormat, swUserPreferenceOption_e.swDetailingGeneralTable)
myTextFormat.CharHeight = 0.0025
boolstatus = Part.Extension.SetUserPreferenceTextFormat(swUserPreferenceTextFormat_e.swDetailingGeneralTableTextFormat, swUserPreferenceOption_e.swDetailingGeneralTable, myTextFormat)

Vorlage = "...\Tabelle.sldtbt" <- Hier Pfad zur Vorlage eintragen

Set myTable = Part.InsertTableAnnotation2(False, 0.02495, 0.01289, 3, Vorlage, 3, 8)  '(Am Verankergspkt einfügen, X, Y, Verankergspkt li unten, Vorlage, Zeilen, Spalten)

Set view = Part.GetFirstView
nr = 1

Do While Not view Is Nothing
    Set DisplayDimension = view.GetFirstDisplayDimension
   
    For j = 0 To view.GetDimensionCount - 1
        Set Dimension = DisplayDimension.GetDimension
        If DisplayDimension.Inspection = 1 Then
            Wert = Dimension.SystemValue
            tol = Dimension.GetToleranceValues
            Set btol = Dimension.Tolerance
            Präfix = DisplayDimension.GetText(swDimensionTextPrefix)
           
            If Dimension.GetToleranceType = swTolSYMMETRIC Then tol(0) = -tol(1)
            If Dimension.GetToleranceType = swTolFIT Then
                BohrPass = btol.GetHoleFitValue
                WellPass = btol.GetShaftFitValue
            End If
           
            If nr > 1 Then
                boolstatus = myTable.InsertRow(swTableItemInsertPosition_Last, myTable.TotalRowCount)
            End If
           
            ' Zellen mit Werten belegen, Umwandlung in mm
            myTable.Text(nr + 1, 0) = nr                    'Nummer
           
            If Dimension.GetToleranceType = swTolFIT Then  'Wenn Passung
                myTable.Text(nr + 1, 1) = Präfix & Wert * 1000 & " " & BohrPass & WellPass
            ElseIf Dimension.GetToleranceType = swTolSYMMETRIC Then 'Wenn symm.
                myTable.Text(nr + 1, 1) = Präfix & Wert * 1000 & " ±" & tol(1) * 1000
            Else
                myTable.Text(nr + 1, 1) = Präfix & Wert * 1000 & " +" & tol(1) * 1000 & " " & tol(0) * 1000
            End If
           
            myTable.Text(nr + 1, 2) = Präfix & (Wert + tol(1)) * 1000          'oberes Grenzmaß
            myTable.Text(nr + 1, 3) = Präfix & (Wert + tol(0)) * 1000        'unteres Grenzmaß
         
            'Bemaßung nummerieren
            dimstring = "[" + CStr(nr) + "] " & Präfix
            DisplayDimension.SetText swDimensionTextPrefix, dimstring
            nr = nr + 1
        End If
       
        Set DisplayDimension = DisplayDimension.GetNext
   
    Next
   
    Set view = view.GetNextView
   
Loop

boolstatus = Part.ForceRebuild3(True)

End Sub


------------------
CSWA, CSWP, CSWPA-SM =)

(c)2017 CAD.de