---

Hallo Zusammen,

ich habe das Forum bereits durchgeschaut und konnte einen Beitrag finden, bei dem die Prüfmaße in einer externen Excel-Liste aufgelistet werden.
Gäbe es eine Möglichkeit, dass diese nicht in eine Excel-Liste geschrieben werden, sondern mit einer "Prüfmaßtabelle" direkt auf die Zeichnung eingefügt werden?
Hintergrund ist: Wir geben unseren Lieferanten die Zeichnung mit und alle Maße, die mit als Prüfmaße gekennzeichnet werden müssen nachgemessen und der "reale" Wert eingetragen werden. Damit der Konstrukteur die Maße nicht von Hand einfügen müssen, soll ein Makro dies übernehmen.

Hat von Euch einer da schon eine Lösung?

Freue mich über jede Antwort! 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Dirk,

statt in eine Excel-Tabelle in eine SWX Tabelle zu schreiben, sollte kein großes Problem sein.
Hängt halt auch davon ab, was Du Dir davon erwartest z.B.:
- Positionierung der Tabelle
- Berücksichtigung der versch. Formaten
- Wann und Wie soll aktualisiert werden
- ...

Ohne das Makro zu kennen, würde ich als größtes Problem sehen,
Wie werden "Prüfmaße" gehandelt die keine Maße sind und als solche nicht mit der Eigenschaft
Prüfmaß versehen sind.
z.B.: Härteangaben, Form- Lagetoleranzen, ....

Sorry, ich weiß, dass Dir das jetzt nicht viel weiterhilft.
Ich würde einfach mal versuchen das Makro das Du gefunden hast, abzuändern.

------------------
Grüße
Heinz

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Dirk,

wenn ihr häufiger mit Erstmusterprüfberichten usw. zu tun habt, dann
solltet ihr euch vlt. mal das Solidworks Inspection Modul anschauen.
Ich habe keine Ahnung, was der Spaß kostet, aber vielleicht rechnet sich
das für euch.

------------------
==========
Gruß
Andreas
==========

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Heinz, Hallo Andreas,

vielen dank für eure Antworten!

Also Härteangaben, Form und Lagetoleranzen werden hier nicht geprüft.
Es geht vorerst rein um die Maße. Deswegen muss ich hier auch nicht überprüfen, ob etwas vergessen wurde. D.h. alle Maße, die das "Kästchen" bekommen sollen in einer Tabelle eingefügt werden. Die Position kann der Konstrukteur danach noch bestimmen. Die Tabelle soll einfach auf der Zeichnung auftauchen 

@Andreas: Problem ist bei uns, dass wir im Sondermaschinenbau tätig sind, hier sind die Fertigungsteil zu 80% neue Teile. Da wäre es denke ich zu aufwendig, für jedes Teil ein Erstmusterprüfbericht zu erstellen.

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Dirk,

Wir nutzen hierzu INRETO von mbm Solution
Das ist ein AddIn mit dem man Prüfmarken in einer Zeichnung setzten kannst und die Informationen dann nach Excel oder Word ausgegeben werden können.
Auf der Webseite kannst Du dir eine Demo runterladen die du 20 mal starten kannst.

------------------
Pfürti Jörg W 

www.hydac.com / Waleska Webdesign / CAD.de Hilfeseite / CAD.de Stammtisch Saar

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Tabelle.sldtbt.txt

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 =)

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Jens,

das ist genau, was ich gesucht habe   

leider taucht bei mir immer ein Fehler auf. Kannst du mir hierbei evtl. noch helfen?

Wenn ich das Makro ausführe, dann wird bei mir ein Laufzeitfehler angezeigt:

Laufzeitfehler 91:

Objektvariable oder with-Blockvariable nicht festgelegt

ich habe mal einen Screenshot eingefügt, wo der Fehler auftaucht.

[Diese Nachricht wurde von DirkM94 am 29. Mrz. 2017 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Zitat:

---

Original erstellt von DirkM94:
ich habe mal einen Screenshot eingefügt, wo der Fehler auftaucht.

---

Ich seh zwar keinen Screenshot, aber meine Glaskugel sagt mir, dass du vermutlich den Vorlagenpfad noch nicht geändert hast bzw. mein Kommentar noch drin steht:

aus

Code:

---

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

---

muss z.B.

Code:

---

Vorlage = "C:\Temp\Tabelle.sldtbt"

---

werden.

Edit: Und die Tabelle muss natürlich auch an dieser Stelle gespeichert sein. 

Gruß, Jens

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

[Diese Nachricht wurde von CAD-Maler am 29. Mrz. 2017 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Jens,

hatte einen Schreibfehler im Pfad, funktioniert wunderbar  

Ich habe noch folgendes eingefügt, falls das Makro ausgeführt wird, wenn keine Zeichnung bzw. ein Dokument geöffnet ist:

    '* Prüfung ob ein Dokument aktiv ist
    If Part Is Nothing Then
      MsgBox "Keine Zeichnung geladen!", vbMsgBoxSetForeground + vbInformation, "Fehler"
      Exit Sub
    End If
    '* Prüfung ob das aktuell aktive Dokument eine Zeichnung ist
    If Part.GetType <> swDocDRAWING Then
     MsgBox "Aktive Datei ist keine Zeichnung!", vbMsgBoxSetForeground + vbInformation, "Fehler"
    End If

[Diese Nachricht wurde von DirkM94 am 30. Mrz. 2017 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Zitat:

---

Original erstellt von DirkM94:
Hallo Jens,

hatte einen Schreibfehler im Pfad, funktioniert wunderbar    

Ich habe noch folgendes eingefügt, falls das Makro ausgeführt wird, wenn keine Zeichnung bzw. ein Dokument geöffnet ist:

    '* Prüfung ob ein Dokument aktiv ist
    If Part Is Nothing Then
      MsgBox "Keine Zeichnung geladen!", vbMsgBoxSetForeground + vbInformation, "Fehler"
      Exit Sub
    End If
    '* Prüfung ob das aktuell aktive Dokument eine Zeichnung ist
    If Part.GetType <> swDocDRAWING Then
     MsgBox "Aktive Datei ist keine Zeichnung!", vbMsgBoxSetForeground + vbInformation, "Fehler"
    End If

[Diese Nachricht wurde von DirkM94 am 30. Mrz. 2017 editiert.]

---

Fehlerabfragen und so einen Kram spar ich mir meistens. Sich selbst unentbehrlich machen und so.      

*Klug******er-Modus*

Da fehlt noch ein "Exit Sub" bei der 2. Abfrage...

*/Klug******er-Modus*

Gruß, Jens  

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

[Diese Nachricht wurde von CAD-Maler am 30. Mrz. 2017 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Das muss ich mir merken  
Nun manche Spezialisten ändern dann das Makro wenn ein Fehler auftritt  

funktioniert sogar ohne End Sub

eine Frage hätte ich noch, vllt. weißt du da ja bescheid:

in der Tabelle füge ich ganz unten noch eine Zeile ein, in der der Werker dann unterschreiben muss.

Ich habe den Befehl gefunden, mit dem man Zellen verbinden kann.
Nur habe ich nicht herausgefunden, wie man die letzte Zeile ansprechen kann.

myTable.MergeCells()

[Diese Nachricht wurde von DirkM94 am 31. Mrz. 2017 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Ich werde nicht müde zu erwähnen, was für eine große Hilfe die API-Hilfe von SolidWorks ist...   

Da findest du alles, was du mit einer Tabelle so anstellen kannst, unter anderem dieses Beispiel.   

Alternativ müsstest du den Index der letzten Spalte ja aus der Laufzeit des Makros haben. Oder du holst dir den Index mit TotalRowCount. Oder du fügst die letzte Zeile schon in der Vorlage ein, dann musst du halt die Füllzeilen für die Maße nicht ganz hinten einfügen, sondern vor der letzten Spalte.  Oder oder oder... Viele Wege führen nach Rom.   

Gruß, Jens

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

[Diese Nachricht wurde von CAD-Maler am 31. Mrz. 2017 editiert.]

[Diese Nachricht wurde von CAD-Maler am 31. Mrz. 2017 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Pruefmasstabelle.zip 20170412_Pruefmasstabelle.jpg

Update:

Auf Wunsch meiner Kollegen habe ich das Prüfmasstabellen-Makro noch etwas aufgebohrt: Neben den Prüfmaßen werden nun auch alle (!) Form- und Lagetoleranzen mit in die Tabelle übernommen.

Wie üblich muß im Makro selbst der Pfad zur Tabellenvorlage angepasst werden. Bei uns hängt die Tabelle immer rechts oben auf der Zeichnung. Sollte das anders gewünscht werden, müssen die x- und y-Koords und evtl. der Ankerpunkt der Tabelle noch angepasst werden.

Fehler und Anregungen: Wie immer her damit!

Ansonsten: Viele Spässe damit!

Gruß, Jens

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

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Beispiel.pdf Beispiel2.JPG

Moin,
Ich habe nun beide Makros zusammen gepackt (Ich habe eigentlich gar keine Ahnung davon, klappt aber trotzdem). Nun habe ich aber ein paar Probleme:
- die Tabelle aktualisiert sich nicht, wenn man den Befehl (STRG + Q) gibt?
- Außerdem habe ich manchmal auch die Situation, dass meine Toleranzen nur negativ sind, dann schmeist er mir komische Sachen raus (siehe Bild "Beispiel"). Vom ding her richtig, sieht bloß komisch aus.
- Wenn ich die Tabelle eingefügt habe, kann ich sie nur an den Fixpunkten verschieben, aber nicht "freihändig". Der Hacken zum deaktivieren ist ausgegraut. (siehe Bild "Beispiel 2)

Wäre klasse, wenn mir jemand helfen könnte, bin total unerfahren im programmieren von Makros.

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Maria,

Zitat:

---

- die Tabelle aktualisiert sich nicht, wenn man den Befehl (STRG + Q) gibt?

---

Das Makro kann darauf auch nicht reagieren da keine automatische Aktualisierung eingebaut ist.

Zitat:

---

- Außerdem habe ich manchmal auch die Situation, dass meine Toleranzen nur negativ sind, dann schmeist er mir komische Sachen raus (siehe Bild "Beispiel"). Vom ding her richtig, sieht bloß komisch aus.

---

Da fehlt im Code eine Fallunterscheidung was passieren soll wenn beide Werte negativ bzw. beide Werte positiv sind. Hier kannst du dann folgendes tun:

Code:

---

myTable.Text(nr + 1, 1) = Präfix & Wert * 1000 & " +" & tol(1) * 1000 & " " & tol(0) * 1000

---

ersetzen durch

Code:

---

If tol(1) > 0 And tol(0) > 0 Then
myTable.Text(nr + 1, 1) = Präfix & Wert * 1000 & " +" & tol(0) * 1000 & " +" & tol(1) * 1000
ElseIf tol(1) < 0 And tol(0) < 0 Then
myTable.Text(nr + 1, 1) = Präfix & Wert * 1000 & " " & tol(1) * 1000 & " " & tol(0) * 1000
Else
myTable.Text(nr + 1, 1) = Präfix & Wert * 1000 & " +" & tol(1) * 1000 & " " & tol(0) * 1000
End If

---

Das du deine Tabelle frei ziehen kannst, könntest du folgende Zeile im Code nach der Set myTable = ... Anweisung einfügen.

Code:

---

myTable.Anchored = False

---

Mich wundert hier nur wieso verankert wird obwohl "False" für das Verankern in der Set myTable Anweisung gesetzt ist. 

Gruß
Bernd

------------------
--- Man muß nicht alles wissen, man muß nur wissen wo es steht ---

Staatlich anerkannte Deutschniete  

[Diese Nachricht wurde von bk.sc am 09. Jan. 2018 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Beispiel3.JPG

Hallo Bernd,

Danke für die Hilfe.
- Punkt 2 funktioniert super. Die einzelnen Fälle werden jetzt unterschieden.
- Hast du oder jemand anderes eine Idee wie man Punkt 1 ändern kann?
- Punkt 3 funktioniert leider immer noch nicht. Sorry. (siehe Beispiel 3)

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Maria,

Zitat:

---

- Hast du oder jemand anderes eine Idee wie man Punkt 1 ändern kann?

---

Ideen ja, nur ist dass dann nicht mehr ganz so einfach und auf die schnelle umgesetzt, weil hier müsstest du dann mit Events arbeiten wenn es denn unbedingt bei STRG + Q aktualisiert werden soll.

Zitat:

---

- Punkt 3 funktioniert leider immer noch nicht. Sorry. (siehe Beispiel 3)

---

Dass wundert mich aber, da es bei mir so einwandfrei funktioniert, evtl. könnte sich da in der API von SWX 2018 was geändert haben, was ich leider nicht nachprüfen kann.

Gruß
Bernd

------------------
--- Man muß nicht alles wissen, man muß nur wissen wo es steht ---

Staatlich anerkannte Deutschniete 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Laufzeitfehler.PNG

Moin,
das ist ja ein super Makro!!
Könnten wir in unserer Abteilung richtig gut gebrauchen.

Nur leider funktioniert es bei mir nicht bei Winkelmaßen.
Bei mir kommt immer:
Laufzeitfehler '5': Ungültiger Prozeduraufruf oder ungültiges Argument (siehe Screenshot).

Hat jemand ne Idee, woran das liegen könnte?

LG
Henrik

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Henrik,

ich kenn den Code des Makros zwar nicht. Aber schau Dir mal in der Online Hilfe
an welche Werte GetPrimaryPrecision2 liefert.
Wenn ich mich nicht  verlesen habe, nämlich nur negative Werte

------------------
Grüße
Heinz

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Henrik,

GetPrimaryPrecision2 liefert nur zurück wie die Genauigkeit definiert ist d.h. sie liefert also nicht wie hier wahrscheinlich vermuttest die Anzahl der Nachkommastellen.

Gruß
Bernd

------------------
--- Man muß nicht alles wissen, man muß nur wissen wo es steht ---

Staatlich anerkannte Deutschniete 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Moin,

ein Kollege (kein "SolidWorker") hat mir den Code umgeschrieben...jetzt funktionierts, soweit ich es beurteilen kann.
Falls jemand Interesse hat:
von:

Code:

---

          If BemTyp = 1 Then
                Typ = "Winkel"
                Wert = 360 / (2 * pi) * Wert
                Wert = Round(Wert, DisplayDimension.GetPrimaryPrecision2)

---

in:

Code:

---

            If BemTyp = 1 Then
                Typ = "Winkel"
                Wert = 360 / (2 * pi) * Wert
                PrimaryDimension2 = DisplayDimension.GetPrimaryPrecision2
                If PrimaryDimension2 < 0 Then
                    PrimaryDimension2 = PrimaryDimension2 * (-1)
                End If
                Wert = Round(Wert, PrimaryDimension2)

---

Zusätzlich hat er oben PrimaryDimension2 als Interger definiert:

Code:

---

Dim PrimaryDimension2 As Integer

---

Ich weiß nicht, ob es die eleganteste Lösung ist, aber es läuft 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Hernik,

was sollen diese Zeilen den bitte machen? Weil ich glaube nicht das der Code irgendwie was sinnvolles macht.
Die möglichen Rückgabewerte von GetPrimaryPrecision2 sind nähmlich:

-swDoNotChangePrecisionSetting / -1
-swPrecisionFollowsDocumentSetting / -2
-swTolerancePrecisionFollowsNominal / -3

Diese sind daher immer negativ.

Ich denke auch wenn du diese Zeilen weglässt sich nichts am Ergebnis ändert.

Gruß
Bernd

------------------
--- Man muß nicht alles wissen, man muß nur wissen wo es steht ---

Staatlich anerkannte Deutschniete 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

OK ...war mir nicht klar, dass die Zahlen für bestimmte Einstellungen stehen.
Mein Kollege hat das Ganze natürlich nicht aus SolidWorks-Sicht betrachtet und ich hab kaum Erfahrung mit VBA.
Aber: Auch wenn der Code nix sinnvolles macht: Die Fehlermeldung ist weg 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hab die Rückgabewerte jetzt noch einmal genauer angeschaut und habe folgendes herausgefunden:

- Wenn die Genauigkeiten manuell eingestellt werden gibt GetPrimaryPrecision2 die Nachkommastellen zurück, nur wenn die Eisntellung auf z.B. ".123(Dokument)" gestellt ist bekommt man die -2 als Rückgabewert.

- Wenn bei der Toleranzgenauigkeit auf "wie Nominal" gestellt wird gibt GetPrimaryTolPrecision2 -3 als Rückgabewert und analog wie oben bei ".12(Dokumet) auch die -2.

Das heist bei deinem Code bei ungünstiger Kombination von den Dokumenteinstellungen für die Genauigkeiten, wird in der Tabelle falsch gerundet, weil immer auf 2 bzw 3 Nachkommastellen gerundet wird.

Zum Hintergrund, diese Prozedur mit dem Auswerten der Einstellungen für die Nachkommastellen benötigt mann, weil SWX intern mit Radiant arbeitet und hier beim umrechnen auf Grad Rundungsfehler im Bereich der glaub 10. Nachkommastelle entstehen. Ohne diese Prozedur würden die rechnerischen Werte auch mit dieser Anzahl von Nachkommastellen in der Tabelle angeziegt werden.

Hier mal ein korrigierter Code der alle Eventuallitäten berücksichtigen sollte, hierzu muss nur noch ModelDocExt deklariert werden und entsprechend zugewiesen.

Code:

---

    'Bemaßungen
    Set DisplayDimension = view.GetFirstDisplayDimension
   
    For j = 0 To view.GetDimensionCount - 1
        Set Dimension = DisplayDimension.GetDimension
        If DisplayDimension.Inspection = 1 Then
            Wert = Dimension.SystemValue
           
            BemTyp = Dimension.GetType
           
            If BemTyp = 1 Then
                Typ = "Winkel"
                Wert = 360 / (2 * pi) * Wert
                If DisplayDimension.GetPrimaryPrecision2 < 0 Then
                    BemPrecision = ModelDocExt.GetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swDetailingAngularDimPrecision, swUserPreferenceOption_e.swDetailingAngleDimension)
                Else
                    BemPrecision = DisplayDimension.GetPrimaryPrecision2
                End If
               
                Wert = Round(Wert, BemPrecision)
            Else
                Typ = "Länge"
            End If
           
            tol = Dimension.GetToleranceValues
            If BemTyp = 1 Then
              
               If DisplayDimension.GetPrimaryTolPrecision2 = -2 Then
                    TolPrecision = ModelDocExt.GetUserPreferenceInteger(swUserPreferenceIntegerValue_e.swDetailingAngularTolPrecision, swUserPreferenceOption_e.swDetailingAngleDimension)
               ElseIf DisplayDimension.GetPrimaryTolPrecision2 = -3 Then
                    TolPrecision = BemPrecision
               Else
                    TolPrecision = DisplayDimension.GetPrimaryTolPrecision2
               End If
              
               tol(0) = 360 / (2 * pi) * tol(0)
               tol(0) = Round(tol(0), TolPrecision)
              
               tol(1) = 360 / (2 * pi) * tol(1)
               tol(1) = Round(tol(1), TolPrecision)

            End If

---

Code:

---

Dim ModelDocExt as Object
Set ModelDocExt Part.Extesion

---

Gruß
Bernd

[EDIT] U.a. Hintergrund wieso diese Prozedur nötig ist ergänzt.

------------------
--- Man muß nicht alles wissen, man muß nur wissen wo es steht ---

Staatlich anerkannte Deutschniete  

[Diese Nachricht wurde von bk.sc am 11. Jan. 2018 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Moin,

"Hier mal ein korrigierter Code der alle Eventuallitäten berücksichtigen sollte, hierzu muss nur noch ModelDocExt deklariert werden und entsprechend zugewiesen."

Da ich ja wirklich keine Ahnung habe, funktioniert es leider bei mir nicht.
Vielleicht kann mir jemand sagen, was ich da deklarieren muss?

Sorry für die doofen Fragen, aber ich wurde von meinen Chef an diese Aufgabe gesetzt, obwohl ich keine Ahnung habe. Dank eurer Hilfe bin ich aber schon ziemlich weit.   

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Maria,

das "Dim ModeldocExt As Object" fügst du ganz oben bei den anderen Deklarationen ein also da wo auch z.B. "Dim Part As Object" steht.
Das "Set ModelDocExt = Part.Extension" fügst du unter der Zeile "Set Part = swApp.ActiveDoc" ein, dann sollte es klappen.

Sag deinem Chef aber vorher das du für nichts garantieren kannst wenn du Macros aus dem WWW verwendest ohne zu wissen was diese wirklich tun, weil es gibt auch sehr mächtige Macros mit dennen du bei falscher Anwendung gut Schaden anrichten kannst. Hier im Brett ist das Risiko etwas geringer, weil in den meisten Threads dazu auch beschrieben ist auf was mann achten muss bzw. was sie wie tun, dies ist aber natürlich nicht bei allen anderen Quellen auch so.

Gruß
Bernd

------------------
--- Man muß nicht alles wissen, man muß nur wissen wo es steht ---

Staatlich anerkannte Deutschniete 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

PruefmasseV1.zip

Hallo zusammen,

anbei das überarbeitete Macro.

Anpassungen:

-Überarbeitung der Auswertung der Nachkommastellen für Winkelbemaßungen
-Fallunterscheidung bei zweiseitigen Toleranzen wenn beide Toleranz-Werte positiv bzw. negativ sind

Gruß
Bernd

------------------
--- Man muß nicht alles wissen, man muß nur wissen wo es steht ---

Staatlich anerkannte Deutschniete 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Sorry...ich muss noch mal um Hilfe bitten 
Bei mir werden Winkelmaße jetzt wunderbar gerundet.
Längenmaße werden jedoch mit extrem vielen Nachkommastellen in die Tabelle eingetragen:
Ich habe einen Durchmesser von 4mm im Teil.
Das Makro liest als Wert schon (komische) "3,9999999999999999E-03" ein und rundet danach nicht (ist ja auch kein Befehl dafür vorhanden bei Längenmaßen soweit ich sehen kann).
Wenn ich mir aber auch bei Längenmaßen mit "GetPrimaryPrecision2" die Genauigkeit hole und anschließend runden lasse, rundet das Makro von 4 auf 0 runter...es ignoriert einfach die ausgelesenen Nachkommastellen (im Debugging kann ich sehen, dass SolidWorks 2 Nachkommastellen "anfordert")

Hat jemand eine Idee, woran das liegen könnte?

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Henrik,

kannst du den Code Abscchnitt den du geändert hast hier posten, dann sehen wir auch was du wirklich geändert hast.

Gruß
Bernd

------------------
--- Man muß nicht alles wissen, man muß nur wissen wo es steht ---

Staatlich anerkannte Deutschniete 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

TEST.zip

Moin,

ich habe gestern das Makro anscheinend "zerbastelt" ...wenn ich deine V1 neu lade, funktioniert das Runden wieder.
Leider habe ich aber dann weiterhin eine Fehlermeldung wegen den Toleranzgenauigkeiten beim Ausführen des Makros (Laufzeitfehler '13': Typen unverträglich).
Solange die Toleranzgenauigkeit auf ".12 (Dokument)" steht, gibt es diese Fehlermeldung. Selbst wenn gar keine Toleranz angewählt ist.
Sobald ich eine Toleranz aktiviere, die Genauigkeit manuell umstelle und dann die Toleranz wieder deaktiviere (weil ich keine Brauche), funktioniert das Makro ohne Probleme.

Ich hab mal eine Beispielzeichnung angehängt.

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Henrik,

kann die Datei leider nicht öffnen, bin noch mit der Version 2016 unterwegs.
Ich kann kein Fehlverhalten reproduzieren egal was ich bei Tolranztyp bzw. Toleranzgenauigkeit einstelle.

Kannst du bitte Mal einen Screenshot machen wo du den Laufzeitfehler im Macro bekommst und am besten auch gleich mit dem Ausschnitt der Zeichnung mit der Bemaßung welche deiner Meinung nach den Fehler produziert.

Gruß
Bernd

------------------
--- Man muß nicht alles wissen, man muß nur wissen wo es steht ---

Staatlich anerkannte Deutschniete 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Typenunvertraeglich.jpg Mas.jpg Dokumenteigenschaften.PNG

Hi,

anbei ein paar Screenshots.
Das Makro bleibt bei mir leider schon beim ersten Maß hängen. Tol(0) sowie tol(1) zeigen bei mir <Typen unverträglich> an.
Ich gucke jetzt mal per Einzelschritt, ab wann die Typen unverträglich werden.

EDIT: Ich habe gerade gemerkt, dass das Makro weiterläuft, sobald ich bei dem Maß die Toleranz einmal von "Keine" auf "Grundlegend" und dann wieder zurück auf "Keine" schalte (ohne die Toleranzgenauigkeit umzuschalten).
Dann hängt das Makro dafür aber beim nächsten Maß wieder genauso fest (ich könnte jetzt bei allen Maßen 1x hin und her schalten, dann läuft das Makro komplett sauber durch)

[Diese Nachricht wurde von Captain Feature am 17. Jan. 2018 editiert.]

[Diese Nachricht wurde von Captain Feature am 17. Jan. 2018 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Henrik,

ich kann das irgendwie nicht reproduzieren egal was ich da für den Toleranztyp einstelle, evtl. hängt das Problem mit der Version 2017 zusammen. Ich werde Mal versuchen das die Obsolete Methode "Dimension.GetToleranceValues" durch die neueren GetMaxValue Method (IDimensionTolerance) / GetMinValue Method (IDimensionTolerance) zu ersetzten.

Gruß
Bernd

------------------
--- Man muß nicht alles wissen, man muß nur wissen wo es steht ---

Staatlich anerkannte Deutschniete 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Henrik,

versuch mal

Code:

---

tol = Dimension.GetToleranceValues

---

zu ersetzten durch

Code:

---

Dim tol(1) As Double
           
lWarning = Dimension.Tolerance.GetMinValue2(tol(0))
lWarning = Dimension.Tolerance.GetMaxValue2(tol(1))

---

Die Dim Anweisung kannst du auch nach ganz oben zu den anderen Deklarationen schieben.

Gruß
Bernd

------------------
--- Man muß nicht alles wissen, man muß nur wissen wo es steht ---

Staatlich anerkannte Deutschniete  

[Diese Nachricht wurde von bk.sc am 18. Jan. 2018 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Du bist der Hammer!!!
So funktioniert das Makro ohne Fehlermeldungen.
Vielen vielen Dank für deine ganze Mühe, die du hier reinsteckst!

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Zusammen,

weiß jemand von euch, ob es eine Möglichkeit gibt die Tabelle automatisch erstellen zu lassen, wenn beispielsweise ein Speicherbefehl o.Ä. ausgeführt wird?

Sprich wir haben Keytech im Einsatz und wenn man dann "Keytech speichern" klickt, dass die Tabelle dann automatisch generiert bzw. aktualisiert wird?

Grüße
Dirk

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Dirk,

ich denke da musst du dich mit den Herstellern von keytec in Verbindung setzen. Die müssten das ja in ihr AddIn mit einbauen.

------------------
Grüße

Jörg

man hat nie Zeit es richtig zu machen, aber immer genug Zeit es nochmals zu machen

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo,

ich bin wie schon mehrere hier, auf der Suche nach einem Makro, welches die Maße in einer Zeichnung von Solid-Works (2016) durchgängig nummeriert und stempelt. Problem in unserer Umgebung ist, das wir Lokal auf der Eben von Solid-Works kein Excel nutzen können. Somit kann ich die im Vorfeld zur Verfügung gestellten Makros leider nicht nutzen. Desweiteren benötigen wir keine Tabelle auf der Zeichnung, da wir hierfür ein separates Programm haben. Wir benötigen einfach nur die Durchnummerierung der Maße mit Stempel.
Kann mir hier einer weiterhelfen??

------------------
Mfg & Danke OVSN

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Im Makro hier ist kein Krümel Excel drin. Ob das für 2016 funktioniert, wirst du probieren müssen. Anschließend soweit bearbeiten, dass das Tabelle Erstellen und das Schreiben in die Zellen auskommentiert ist, die "Stempelung" sollte auch unabhängig davon funktionieren. Oder quick'n'dirty: Die Tabelle am Ende vom Makro direkt wieder rauslöschen...

Gruß, Jens

------------------
CSWE =)

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo,

du könntest das Macro aus diesem Thread (Hier entlang)mal auseinander nehmen und schauen wo hier die Blöcke (Fähnchen mit Nummer) erzeugt und Positioniert werden und den Rest einfach rausschmeisen.

Gruß
Bernd

------------------
--- Man muß nicht alles wissen, man muß nur wissen wo es steht ---

Staatlich anerkannte Deutschniete 

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo CAD-Maler,

Tabelle wird erstellt, Text "Prüfung erforderlich" wird eingepflegt. Aber es erfolgt keine Stempelung mit Nummern.
Idee??

------------------
Mfg & Danke OVSN

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Kein Prüfmaß und keine geom. Toleranz in der Zeichnung?
Zuviel auskommentiert?

Code:

---

                'Bemaßung nummerieren
                dimstring = "#" + CStr(nr)
                DisplayDimension.SetText swDimensionTextCalloutAbove, dimstring

---

und

Code:

---

If Tolwert2(0) <> "" Then
                            tolstring = "#" & Tol1Nr & ", #" & Tol2Nr
                        Else
                            tolstring = "#" & Tol1Nr
                        End If
                       
                        boolstatus = gtol.SetText(swGTolTextCalloutBelow, tolstring)

---

müssen mindestens noch aktiv sein. Dann steht dann immerhin schonmal das "#" an den Maßen...

Gruß, Jens

------------------
CSWE =)

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP