| |
| Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für Autodesk Produkte |
Autor
|
Thema: Abfragen ob Positionsnummer gesetzt wurde (mittels VBA) (54 mal gelesen)
|
Zeichnerschlumpf Mitglied Technischer Zeichner
Beiträge: 79 Registriert: 26.01.2010 AutoCAD 2005 LT AutoCAD 2009 Mechanical Inventor 11 + Space Pilot pro Inventor 2009
|
erstellt am: 02. Jun. 2017 14:12 <-- editieren / zitieren --> Unities abgeben:
Hallo ihr lieben, weiß einer von euch, ob man mittels vba die Werte der Stücklistenspalte abfragen kann, in der merkiert wird, ob die Position bereits in der Zeichnung angezogen wird? Vielen Dank euch schon mal. Liebe Grüße
Zeichnerschlumpf Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
RolandD Mitglied
Beiträge: 533 Registriert: 07.01.2005 i7-9700k 32GB DDR4-RAM Nvidia RTX 2060 SSD 970 m.2 Win10-64 (21H2) AIP 2020.3 Dell U3417W
|
erstellt am: 02. Jun. 2017 18:06 <-- editieren / zitieren --> Unities abgeben: Nur für Zeichnerschlumpf
Hallo Zeichnerschlumpf, das geht z.B. so: Das Makro gibt eine MsgBox mit allen Pos ohne Pos-Nr. aus Code: Sub Balloon_Check() 'überprüfen: alle Bauteile positioniert? (Ballooned) Dim oDoc As Inventor.Document Set oDoc = ThisApplication.ActiveDocument If Not oDoc.DocumentType = kDrawingDocumentObject Then Exit Sub If oDoc.ReferencedDocuments.Count > 1 Then MsgBox ("Mehr als eine IAM in der IDW dargestellt" & vbLf & vbLf & "keine Auswertung möglich!") Exit Sub End If Dim oSheet As Sheet Dim oPartsList As PartsList Dim i As Integer Dim s As String s = "" Dim PosFehlt As Boolean PosFehlt = False Dim PL_Anz As Integer PL_Anz = 0 For Each oSheet In oDoc.Sheets PL_Anz = PL_Anz + oSheet.PartsLists.Count Next 'oSheet If PL_Anz = 0 Then 'keine SL vorhanden MsgBox ("ok - keine Stückliste vorhanden (IPT ?)") Exit Sub End If 'PL_anz = 0 Dim MaxAnz As Integer MaxAnz = oDoc.ReferencedDocuments.Item(1).ReferencedDocuments.Count 'Dim PL As PartsList Dim BlattNr As Integer Dim RefName As String RefName = "" Dim PosArray(100) As Boolean 'max 100 SL-Zeilen auswerten 'Balloone prüfen For Each oSheet In oDoc.Sheets For Each oPartsList In oSheet.PartsLists Call PartsListSort 'SL sortieren, dass die Nr. richtig angezeigt wird For i = 1 To oPartsList.PartsListRows.Count If oPartsList.PartsListRows.Item(i).Ballooned Then '= False PosArray(i) = True 's = s & vbLf & i End If Next i Next 'oPartsList Next 'oSheet 'erste Partslist auf allen Blättern suchen For i = 1 To oDoc.Sheets.Count If oDoc.Sheets.Item(i).PartsLists.Count > 0 Then 'PL = oDoc.Sheets.Item(i).PartsLists.Item(1) BlattNr = i Exit For End If Next i Dim fehlende As Integer fehlende = 0 Dim oColl As ObjectCollection Set oColl = ThisApplication.TransientObjects.CreateObjectCollection 'Pos-Nr. und Zei-Nr. anzeigen For i = 1 To oDoc.Sheets.Item(BlattNr).PartsLists.Item(1).PartsListRows.Count If PosArray(i) = False Then fehlende = fehlende + 1 RefName = oDoc.Sheets.Item(BlattNr).PartsLists.Item(1).PartsListRows.Item(i).ReferencedFiles.Item(1).DisplayName s = s & vbLf & i & vbTab & RefName 'RefDoc.DisplayName 'Teil in allen Views highliten, wenn es keinen Balloon hat (funktioniert noch nicht) 'Call oColl.Add(oDoc.Sheets.Item(BlattNr).PartsLists.Item(1).PartsListRows.Item(i).ReferencedFiles.Item(1).FullFileName) End If Next i If s <> "" Then PosFehlt = True MsgBox (fehlende & " Teile ohne Pos-Nr.: " & s) Else MsgBox ("ok - alle Teile mit Pos-Nr.") End If 'fehlende Balloons anbringen If PosFehlt Then '*** Hier wäre super, wenn das Makro alle Teile ohne Balloon selektieren könnte '*** und danach die Pos-Nr. ergänzen könnte, End If 'PosFehlt End Sub 'Balloon_Check
Vielleict kannst du mir ja bei dem letzten Punkt - fehlende Teile selektieren - helfen ------------------ Gruß Roland Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Michael Puschner Ehrenmitglied V.I.P. h.c. Rentner
Beiträge: 12982 Registriert: 29.08.2003
|
erstellt am: 03. Jun. 2017 10:49 <-- editieren / zitieren --> Unities abgeben: Nur für Zeichnerschlumpf
|