Hot News:

Unser Angebot:

  Foren auf CAD.de (alle Foren)
  Inventor VBA
  Abfragen ob Positionsnummer gesetzt wurde (mittels VBA)

  Neues Thema erstellen
CAD.de Login | Logout | Profil | Profil bearbeiten | Registrieren | Voreinstellungen | Hilfe | Suchen

Anzeige:

Thema geschlossen  Thema geschlossen!
Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen

Dieser Beitrag ist erfolgreich in das Forum Inventor VBA verschoben worden.

nächster neuer Beitrag | nächster älterer Beitrag
  
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


Sehen Sie sich das Profil von Zeichnerschlumpf an!   Senden Sie eine Private Message an Zeichnerschlumpf  Schreiben Sie einen Gästebucheintrag für Zeichnerschlumpf

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 oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities


Positionen.JPG

 
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



Sehen Sie sich das Profil von RolandD an!   Senden Sie eine Private Message an RolandD  Schreiben Sie einen Gästebucheintrag für RolandD

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 oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Zeichnerschlumpf 10 Unities + Antwort hilfreich

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



Sehen Sie sich das Profil von Michael Puschner an!   Senden Sie eine Private Message an Michael Puschner  Schreiben Sie einen Gästebucheintrag für Michael Puschner

Beiträge: 12982
Registriert: 29.08.2003

erstellt am: 03. Jun. 2017 10:49    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Zeichnerschlumpf 10 Unities + Antwort hilfreich

Diesen Thread habe ich in das dafür zuständige Forum IV VBA

http://ww3.cad.de/cgi-bin/ubb/forumdisplay.cgi?action=topics&forum=Inventor+VBA&number=258

verschoben und hier abgeschlossen, damit Suchende ihn besser finden können.


------------------
Michael Puschner
Autodesk Inventor Certified Expert
Autodesk Inventor Certified Professional
Mensch und Maschine Scholle GmbH

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

Anzeige.:

Anzeige: (Infos zum Werbeplatz >>)

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen

nächster neuerer Beitrag | nächster älterer Beitrag


Diesen Beitrag mit Lesezeichen versehen ... | Nach anderen Beiträgen suchen | CAD.de-Newsletter

Administrative Optionen: Beitrag öffnen | Archivieren/Bewegen | Beitrag melden!

Fragen und Anregungen: Kritik-Forum | Neues aus der Community: Community-Forum

(c)2023 CAD.de | Impressum | Datenschutz