---

hallo in die Runde
ich tummle mich eigentlich immer auf der CAD Ebene der DIVA herum und meine Hilfeanfrage hat mich über nightsta1k3r hierher geleitet um meine Anfrage hier zu platzieren ...
HAt jemand zufällig ein VBA/Makro in der Programmierschublade das mir ermöglicht alle Prüfmaße auf einer *.idw zu erfassen um sie in einer "Prüfmaß-Tabelle zusammengefasst auf der Zeichnung darstellen zu können
Hauptgrund :um unseren Lieferanten die Zeichnung mit ,allen Maßen die als Prüfmaß gekennzeichnet sind,in einer Tabelle übersichtlich anzuzeigen  und diese Maße nachgemessen und der "reale" Wert im Anschluss an uns übermittelt wird..
wäre eine große Hilfe 

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

---

Moin,

ist zwar nicht VBA sondern iLogic aber macht das was Du willst, denke ich.

Code:

---

'----------------------------------------------
' iLogic: Prüfmaße aus IDW in Tabelle schreiben
'----------------------------------------------

Dim oDoc As DrawingDocument
oDoc = ThisApplication.ActiveDocument

' Name der Tabelle auf dem Blatt
Dim tableName As String = "Prüfmass Tabelle"

' Aktives Blatt
Dim oSheet As Sheet = oDoc.ActiveSheet

' Prüfen, ob Tabelle bereits existiert
Dim oTable As Inventor.CustomTable
Dim tableExists As Boolean = False

For Each tbl As CustomTable In oSheet.CustomTables
    If tbl.Title = tableName Then
        tableExists = True
        oTable = tbl
        Exit For
    End If
Next

' Falls Tabelle fehlt → neue Tabelle erstellen
If Not tableExists Then
    Dim colTitles(2) As String
    colTitles(0) = "Nr."
    colTitles(1) = "Maß"
    colTitles(2) = "Toleranz"

    oTable = oSheet.CustomTables.Add("Prüfmaße", ThisApplication.TransientGeometry.CreatePoint2d(1, 1),colTitles.Length,0,colTitles)
    oTable.Title = tableName
oTable.ShowTitle=True
End If

' Alte Zeilen (bis auf Kopfzeile) löschen
While oTable.Rows.Count > 0
    oTable.Rows.Item(1).Delete
End While

' Sammlung aller Prüfmaße
Dim inspectionDims As New List(Of DrawingDimension)

' Alle Views durchsuchen
    For Each oDim As Inventor.DrawingDimension In oSheet.DrawingDimensions
        If oDim.IsInspectionDimension Then
            inspectionDims.Add(oDim)
        End If
    Next

' In Tabelle eintragen
Dim index As Integer = 1

For Each dimItem As DrawingDimension In inspectionDims

    Dim val As String = dimItem.Text.Text.ToString
    Dim tol As String = ""

    ' Toleranzen auslesen (falls vorhanden)
    Try
        tol = (dimItem.Tolerance.Upper*10) & " / " & (dimItem.Tolerance.Lower*10)
    Catch
        tol = "-"
    End Try

    ' Neue Zeile
    Dim newRow As Row
    newRow = oTable.Rows.Add

    ' Inhalte
    newRow.Item(1).Value = index.ToString()
    newRow.Item(2).Value = val
    newRow.Item(3).Value = tol

    index += 1
Next

MsgBox("Prüfmaße erfolgreich in Tabelle übertragen!", vbInformation)

---

Gruß
Stefan

------------------
Wer nicht mitmacht, kann auch nichts verändern

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

---

Moin

Kleine Ergänzung zu o.g. Code damit die Spalte für die gemessenen Maße gleich mit erzeugt wird, falls die Eintragung auf der Zeichnung gemacht werden soll.

Code:

---

Dim colTitles(2) As String
    colTitles(0) = "Nr."
    colTitles(1) = "Maß"
    colTitles(2) = "Toleranz"

---

ändern zu

Code:

---

Dim colTitles(3) As String
    colTitles(0) = "Nr."
    colTitles(1) = "Maß"
    colTitles(2) = "Toleranz"
    colTitles(3) = "Gemessen"

---

------------------
MfG
Ralf

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