Hot News:

Unser Angebot:

  Foren auf CAD.de (alle Foren)
  Inventor VBA
  Skizziertes Symbol ersetzen, WithLeader

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

Anzeige:

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen nächster neuer Beitrag | nächster älterer Beitrag
Autor Thema:   Skizziertes Symbol ersetzen, WithLeader (164 mal gelesen)
KraBBy
Mitglied
Maschinenbau-Ingenieur


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

Beiträge: 337
Registriert: 19.09.2007

Inventor Professional 2016
Win7

erstellt am: 17. Nov. 2020 14:59    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


20201117_vba_skSymbErsetzen.idw

 
Da ich nun schon eine Weile an diesem Problem knabbere, könnte ich Hilfe gebrauchen. Bereits jetzt vielen Dank fürs Lesen.

In der geöffneten Zeichnung soll ein skizziertes Symbol durch ein anderes ersetzt werden. Meist wird das Symbol mit einer (1) Führungslinie (Leader) an einem Objekt hängen. Mehr als ein Leader muss nicht von diesem Makro abgedeckt werden.

Ursprünglich habe ich versucht, nur die .Definition des vorhandenen Symbols auf die neue Definition zu ändern. Das hat aber nicht geklappt. Hier könnte schon die Lösung liegen: Ist das Ändern der Definition doch möglich? Wie macht das die DIVA, wenn man von Hand das Symbol doppelt klickt (oder Kontextmenü "Symbol bearbeiten") und ein anderes Symbol auswählt? Dabei bleiben die Führungslinien ja auch wie sie sind.

Der aktuelle Plan ist, das Symbol neu zu erstellen. Dabei Inhalt und Position vom vorhandenen Symbol zu übernehmen. Das klappt, wenn es keine Führungslinie gibt, oder auch wenn die Führungslinie nicht an einem Objekt hängt. Es klappt aber nicht, wenn die Führungslinie am 'falschen' Objekt hängt. Bisher bin ich auf zwei Arten von Problemen gestoßen:

Problem A: bei einem Bezugssymbol
hier scheint es kein 'richtiges' AttachedEntity (oSkSymbVorh.Leader.AllLeafNodes.Item(1).AttachedEntity) zu geben

Problem B: bei Form- und Lagetoleranzen, Oberflächensymbolen, anderen skizz.Symbolen
hier schlägt das Erstellen des neuen Symbols fehl. Obwohl bis dahin (für mich) alles gut aussieht 

Ich habe ein Beispiel angehängt, das diese Fälle enthält. Der Code ist auch enthalten. Ich füge ihn aber trotzdem hier ein.

Code:
Option Explicit

Sub idw_IndexSymb_ersetzen()
' KraBBy 17.11.2020

Const sQSname = "Symb_alt"  'Name des vorhandenen, alten Symbols, das ersetzt werden soll
Const sIndexSymb = "Symb_neu"  'Name des neuen Symbols

    'Verweis auf aktives Dokument
    Dim oDoc As DrawingDocument 'Document
    Set oDoc = ThisApplication.ActiveDocument
   
    'SelectSet des aktiven Dokuments
    Dim oSel As SelectSet
    Set oSel = oDoc.SelectSet
    If Not 0 = oSel.Count Then oSel.Clear 'ggf. Markierung aufheben

       
    'Definition vom neuen Symb
    Dim oSketchSymDef As SketchedSymbolDefinition
    Set oSketchSymDef = oDoc.SketchedSymbolDefinitions.Item(sIndexSymb)
    If oSketchSymDef Is Nothing Then Exit Sub 'etwas hat nicht geklappt
   
    'Vorbereiten einer Collection mit den "alten Symbolen", werden am Ende gelöscht
    Dim oCol2Del As ObjectCollection
    Set oCol2Del = ThisApplication.TransientObjects.CreateObjectCollection
   
    'Alle Aktionen zum Ersetzen in eine Rückgängig-Aktion packen
    Dim oTxn As Transaction
    Set oTxn = ThisApplication.TransactionManager.StartTransaction(oDoc, "Makro 'Symb. ersetzen'") 'Start oTxn
   
    'Schleife durch alle Symb auf aktivem Blatt
    Dim oSymb As SketchedSymbol
    For Each oSymb In oDoc.ActiveSheet.SketchedSymbols
        If oSymb.Name = sQSname Then
            'SymbolDefinition ändern, wenn Name passt
           
            Call oSel.Select(oSymb) 'markieren (nur damit man sieht um welches Symb. es gerade geht)

            'Set oSymb.Definition = oSketchSymDef    'Definition umsetzen geht nicht!!!?
           
            If replaceSkSymb(oDoc, oSymb, oSketchSymDef) Then    'Aufruf der Function unten und Erfolg
                Call oCol2Del.Add(oSymb)    'zur Collection hinzufügen
            End If
           
            oSel.Clear  'Markierung(en) aufheben

        'Else: 'nix, es geht weiter mit dem nächsten Symb.
        End If
    Next 'oSymb
   
    'Transaction beenden und neue starten zum Löschen der ersetzten Symbole
    oTxn.End
    Set oTxn = ThisApplication.TransactionManager.StartTransaction(oDoc, "Makro 'ersetzte Symb. löschen'") 'Start oTxn
   
    'ersetzte Symbole löschen
    For Each oSymb In oCol2Del
        Call oSymb.Delete
    Next
   
    oTxn.End    '2. Transaction beenden

End Sub

Private Function replaceSkSymb(oDoc As DrawingDocument, oSkSymbVorh As SketchedSymbol, _
                            oSkSymbDefNeu As SketchedSymbolDefinition) As Boolean
' vorhandenes skizziertes Symbol ersetzen durch ein anderes
' Anzahl angeforderter Eingaben muss übereinstimmen
' es wird ein neues Symb. erstellt, das bisherige bleibt (ggf. im Aufruf löschen)
'
' oDoc          : (aktives) Drawing-Dokument
' oSkSymbVorh  : vorhandenes Skizz.Symbol mit oder ohne Leader
' oSkSymbDefNeu : Definition des neuen Symbols (muss bereits in oDoc vorhanden sein
'
' Rückgabewert True: Aufruf erfolgreich, keine Probleme erkannt
' Rückgabewert False: Fehler aufgetreten, Function wurde vorzeitig verlassen etc.
'
' KraBBy 09.11.2020
   

    replaceSkSymb = False 'Default Rückgabewert der Funktion
   
    'Anzahl angeforderte Eingaben und entspr. Array vorbereiten
    Dim iPrompts As Integer, sPrompts() As String
    '[...] hier im Bsp. keine Eingabefelder
   
    Dim oSkSymbNeu As SketchedSymbol    'wird neues Symbol
   
On Error GoTo 0 'Fehlerbehandlung aus, um zu sehen, dass hier nix schief geht

    If oSkSymbVorh.Leader.HasRootNode Then  'Symbol hat einen Leader
   
        Dim oLeaderPoints As ObjectCollection
        Set oLeaderPoints = ThisApplication.TransientObjects.CreateObjectCollection()
       
        Dim oNode As LeaderNode
        For Each oNode In oSkSymbVorh.Leader.AllNodes
            Call oLeaderPoints.Add(oNode.Position.Copy) ' .Copy hinzu um unabhängigen Punkt zu erhalten
        Next oNode
       
        Dim oGeometryIntent As GeometryIntent
       
On Error GoTo err_handler_P1
        If oSkSymbVorh.Leader.AllLeafNodes.Item(1).AttachedEntity Is Nothing Then
            'das Symb hängt an keinem Objekt
            ' dann hier nix zu tun
        Else
On Error GoTo 0 'Fehlerbehandlung aus, um zu sehen, dass hier nix schief geht
            'hängt an einem Objekt
            Call oLeaderPoints.Remove(oLeaderPoints.Count)  'letzte Node entf, das wird der GeometryIntent
            With oSkSymbVorh.Leader.AllLeafNodes.Item(1).AttachedEntity
                Set oGeometryIntent = oDoc.ActiveSheet.CreateGeometryIntent(.Geometry, .Intent) 'liegt hier der Hund begraben? [Intent] lässt vieles zu
            End With
            Call oLeaderPoints.Add(oGeometryIntent)
        End If
       
On Error GoTo err_handler_P2
        Set oSkSymbNeu = oDoc.ActiveSheet.SketchedSymbols.AddWithLeader(oSkSymbDefNeu, oLeaderPoints, oSkSymbVorh.Rotation, 1)
        '-> Scale auf 1 gesetzt, im Bsp. keine [PromtStrings]
        ' funktioniert, wenn Symb an Linie, oder Maß hängt;
        ' NICHT aber bei FormLageToleranz!
        ' NICHT aber bei SkizzSymbol!
        ' WARUM???
       
        'Leader visible analog zur Vorlage
        oSkSymbNeu.LeaderVisible = oSkSymbVorh.LeaderVisible
       
    Else 'kein Leader
        Set oSkSymbNeu = oDoc.ActiveSheet.SketchedSymbols.Add(oSkSymbDefNeu, oSkSymbVorh.Position, oSkSymbVorh.Rotation, 1)
        '-> Scale auf 1 gesetzt, im Bsp. keine [PromtStrings]
    End If
On Error GoTo 0 'Fehlerbehandlung aus, um zu sehen, dass hier nix schief geht
   
    'Statisch ja/nein analog zur Vorlage?
    'oSkSymbNeu.Static = oSkSymbVorh.Static
    oSkSymbNeu.Static = True    'generell statisch!
   
    'Rückgabe
    replaceSkSymb = True
    Exit Function
   
    'Fehlerbehandlung
err_handler_P1:
    MsgBox Err.Number & vbCrLf & Err.Description, vbOKOnly, "Fehler A"
    'Stop
    Exit Function

err_handler_P2:
    MsgBox Err.Number & vbCrLf & Err.Description, vbOKOnly, "Fehler B"
    'Stop
End Function


------------------
Gruß KraBBy

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

rkauskh
Moderator
Dipl.-Ing. (FH) Versorgungstechnik


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

Beiträge: 1675
Registriert: 15.11.2006

Windows 10 x64, AIP 2021

erstellt am: 18. Nov. 2020 18:08    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 KraBBy 10 Unities + Antwort hilfreich

Hallo

Das Ändern der Definition ist meines Wissens nicht möglich. Vom Augenschein her übernimmt der Dialog auch "nur" die Einstellungen des alten Symbols, löscht dieses, fügt das Neue ein.

Ich denke mit Problem A und B kannst du nur einen Bugreport (ich glaub offiziell heißt das mittlerweile change request) an Autodesk senden und hoffen. 
Wenn die Bezugssymbole keine Attached Entity liefern, kannst du nichts machen. Der GeometryIntent, der aus dem Dummy Skizz. Symbol erstellt wird, sieht zwar ok aus, aber das war's auch schon. Ich unterstelle mal, da hatte jemand keine Lust mehr das zu implementieren oder das Budget war alle.

Alternative Ansätze, die vielleicht helfen könnten (falls das alte Symbol komplett ersetzt wird):
1. In einer zweiten Zeichnung das neue skizzierte Symbol erstellen, aber gleich dem altem Symbol benennen. Neues skizziertes Symbol in die alte Zeichnung kopieren. Hierbei kann angegeben werden, dass die alte Symboldefinition ersetzt werden soll. Anschließend könnte man die Symboldefinition in der neuen Zeichnung umbenennen. Für komplexe Symbole meiner Meinung die beste Wahl.

2. Die Symboldefinition (Skizze) des alten Symbols per API bearbeiten und speichern. Die Symboldefinition kann man anschließend umbenennen. Die Variante ist nur für sehr einfache Symbole geeignet.

3. Symbolbibliothek anlegen und neue Symboldefinition unter altem Namen dort ablegen. In Zeichnung rechte Maustaste auf alte Symboldefinition im Browser und "Symbolbibliotheken"  auswählen. Im Dialog das neue Symbol aus der Bibliothek auswählen, Ersetzen wählen und mindestens eines auf dem Blatt einfügen (kann man später wieder löschen). Einfüge abbrechen, alle bereits vorhandenen Symbole passen sich der neuen Definition an.

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

RKW Solutions GmbH
www.RKW-Solutions.com

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

KraBBy
Mitglied
Maschinenbau-Ingenieur


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

Beiträge: 337
Registriert: 19.09.2007

Inventor Professional 2016
Win7

erstellt am: 18. Nov. 2020 22:01    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 KraBBy 10 Unities + Antwort hilfreich

Hallo Ralf,
danke für Deine Einschätzung. Leider will ich nicht alle derartigen Symbole ersetzen, sondern nur die, ohne einen numerischen Text.

Verstehe ich das richtig, dass Du das makro mit IV2021 ausprobiert hast? Da hat sich also wohl nix getan seit Version 2016?

Ich werde jetzt versuchen, die Fehler abzufangen und das Symbol ohne geometryIntent zu erstellen. Schließlich gebe ich dem User noch einen Hinweis, dass er das Symbol von Hand wieder anhängen soll. Ich habe auch schon ein Makro, das alle Symbole auflistet, die nicht an einem Objekt hängen. So kann man die Problem-Symbole zumindest wieder schnell finden.

------------------
Gruß KraBBy

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

rkauskh
Moderator
Dipl.-Ing. (FH) Versorgungstechnik


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

Beiträge: 1675
Registriert: 15.11.2006

Windows 10 x64, AIP 2021

erstellt am: 19. Nov. 2020 07:37    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 KraBBy 10 Unities + Antwort hilfreich

Moin

Ja, hab's mit 2021 versucht.
Es kann sein, dass der Wunsch das zu implementieren bisher niemand gemeldet hat. Die Entwicklung muss sich wohl öfter entscheiden; alte Feature nachpflegen oder Feature des neuen Release implementieren. Die Prio liegt dann auf den neuen Features.

Man könnte den "abgehangenen" Symbolen einen Scale von 3 geben. Dann fallen die wenigstens richtig auf.

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

RKW Solutions GmbH
www.RKW-Solutions.com

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
Antwort erstellen


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

Administrative Optionen: Beitrag schliessen | Archivieren/Bewegen | Beitrag melden!

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

(c)2020 CAD.de | Impressum | Datenschutz