---

BeispielSymbole.idw

Hallo an alle,
ich möchte in einem Skizzensymbol zwei (oder mehr) angeforderte Eingaben über Textboxen füllen.
Teillösung 2 (Anhang) funktioniert nur mit einer.
Weiterhin möchte ich in Teillösung 2 das Symbol frei positionieren, wie bei Teillösung 1.

Es wäre toll, wenn ihr mir dabei helfen könnt. Alleine bekomme ich es nicht hin.
Dafür sind meine VBA Kenntnisse zu gering.

Viele Grüße pa

PS: Warum macht er aus der idw eine txt?

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

---

zur Teillösung 2 kann ich evtl. ein wenig was beitragen:

Mit deinem Gerüst kann man sehr wohl beliebig viele angef. Eingaben befüllen.
Du musst nur das Array mit den Texten entsprechend groß machen (bei Dir mit der Zeile "Dim sPromptStrings(0) As String" enthält es eben nur 1 Element). Ich habe das im Code-Auszug unten verallgemeinert. Ich bringe das Array immer auf die richtige Größe, egal wie viele angef. Eingaben das Symbol enthält.
(Achtung, bei mir heißt as Array asPromptStr(); a: Array; s: String)

Code:

---

    'PromptStrings (Arraygröße muss der Anzahl angeforderter Eingaben entsprechen!)
    Dim i As Integer, a As Integer
    i = Anzahl_AngefEingabe(oSketchSymDef)  'Aufruf Function, gibt die Anzahl nötiger Eingaben zurück
    Dim asPromptStr() As String
    ReDim asPromptStr(0 To (i - 1))
    For a = 0 To i - 1
        asPromptStr(a) = "" 'Array initialisieren
    Next 'a

Function Anzahl_AngefEingabe(ByRef oSketchSymDef As SketchedSymbolDefinition) As Integer
    'Anzahl "angeforderter Eingaben" ermitteln
    '
    ' KraBBy 28.5.2018
    '
    Dim sTmp As String, oTB As TextBox
    Dim iCnt As Integer: iCnt = 0
    For Each oTB In oSketchSymDef.Sketch.TextBoxes
        sTmp = oTB.FormattedText
        If InStr(sTmp, "/Prompt") Then iCnt = iCnt + 1
    Next
    'iCnt ist jetzt die gesuchte Anzahl
    Anzahl_AngefEingabe = iCnt    'Rückgabewert
   
    'Aufräumen
    Set oTB = Nothing
End Function

---

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

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

---

zu Deiner Ideal-Lösung fällt mir leider nur ein 'von hinten durch die Brust ins Auge'-Konzept ein. Ich will es Dir trotzdem nicht vorenthalten:

zunächst ein Dummy-Symbol, ohne angef. Eingaben gemäß Lösung 1 einfügen. (Sollte die gleiche Größe und den gleichen Bezugspunkt haben)
-> das wäre frei positionierbar
Wenn platziert könnte man dieses Symbol zu greifen kriegen (entweder über den Namen, oder auch das letzte Symbol in der Liste auf dem aktiven Blatt). Davon die Position abgreifen und merken.
Symbol löschen.
Das eigentliche Symbol einfügen, gemäß Lösung 2
-> Texte vom Formular
-> an der gemerkten Position vom Dummy

Soll das Symbol auch an anderer Geometrie hängen? Dann wird es noch etwas schwieriger...

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

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

---

BeispielSymbole.idw

@ KraBBy,

vielen Dank, für deine schnelle Antwort.
Sicherlich trägt dein Code zur Lösung des Problems bei.
Jedoch habe ich kaum Ahnung von VBA und habe jetzt mehrere Stunden versucht, deinen Code einzubinden. Jedoch ohne Erfolg.
Mit den Angaben unter Achtung habe ich dann einiges probiert, da ich das nicht genau verstanden habe.
Habe jetzt in der Anlage erst nur mal deinen Code an die Stelle von "Dim sPromptStrings(0) As String" kopiert.
Meine Versuche habe ich alle wieder gelöscht. Habe da nach zwei Stunden selbst nicht mehr durchgeblickt, was ich alles geändert hatte.

Gruß pa200

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

---

@KraBBy,

ich bin etwas verwirrt. Löst der Code nicht das Problem, das ich den Inhalt von zwei Textboxen in das Skizzensymbol einfügen kann?
Ich versehe sonst deine zweite Antwort nicht.
Die Ideallösung soll eigentlich "nur" das freie Ablegen von Teillösung 1 können und zwei (oder mehr) Inhalte aus Textboxen in die Skizzensymbole schreiben.

Vielleicht ist das auch zu Viel für meine geringen VBA Kenntnisse.

Gruß pa200

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

---

Sorry für die Verwirrung. Mein Code Schnipsel stammt aus einer Anwendung von mir und ist nicht ohne weiteres bei dir verwendbar.

Hier die kleine Lösung (die ich jetzt vom Handy aus zustande bekomme) :
mach aus dieser Zeile
  Dim sPromptStrings(0) As String
das hier
  Dim sPromptStrings(1) As String
dann kannst du zwei angef. Eingaben bedienen.

Das befüllen vom Array ist klar? (machst du ja schon für das erste Element)

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

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

---

Mein Code aus dem ersten Post war gedacht zur TeilLösung 2. (ja, um mehrere Textboxen füllen zu können.) Da fehlt aber das freie platzieren. Man kann das Symbol nur an einer (im Code) gegebenen Stelle positionieren.
Mein zweiter Post zur Ideallösung sollte eben eine Möglichkeit skizzieren, die Vorteile der beiden TeilLösungen zu verbinden. Also den grob beschriebenen Ablauf in ein einziges Makro packen... Knopf auf deinem Formular drücken, User platziert das DummySymbol, das Makro nimmt die Koordinaten davon, platziert an dieser Stelle das eigentliche Symbol unter Benutzung der Formulartexte, löscht schließlich den Dummy.

Das ist wohl etwas viel für einen Anfänger zur Umsetzung, aber ich hoffe, die Idee wird etwas verständlicher.

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

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

---

@ KraBBy,

vielen herzlichen Dank, für Deine Mühe. Ich habe den Code der Teillösung 2 für die Ideallösung jetzt einmal so verändert, das er zwei oder mehr angeforderte Eingaben übernimmt.
Jetzt werde ich versuchen, dass das Symbol auch noch frei zu positionieren ist.
Das dumme ist, wie es fast immer so ist, ein eiliger Kundenauftrag. Ich werde wohl erst einmal was arbeiten müssen. Melde mich aber zur gegebener Zeit wieder.

Nochmals herzlichen Dank und ein schönes Wochenende

pa200

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

---

BeispielSymbole.idw

Habe jetzt die Ideallösung fast gefunden. Deshalb stelle ich die Datei, für alle die es vielleicht auch brauchen können, noch einmal herein.
Einziger Nachteil ist jetzt jedoch noch, dass man das Symbol nicht an einer Linie andocken kann, wie bei Teillösung 1.
DANKE noch einmal an KraBBy. Ohne deine Hilfe hätte ich es nicht hinbekommen.

Gruß Hape

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

---

20210510_sk_Symbole.idw

Jetzt habe ich mir die Zeit genommen, meinen Vorschlag auszuarbeiten.

Anbei das Ergebnis.

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

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

---

mit IV2019 wirst Du das wohl nicht ansehen können, deshalb hier noch der Code

Ich habe ein Modul "KraBBy" erstellt, darin:

Code:

---

'KraBBy 10.05.2021

Option Explicit ' erzwingt die Deklaration von Variablen, dadurch fallen Tippfehler bei Variablen-Namen gleich auf

Private Sub Testaufruf() 'ohne das Formular
    Call KraBBy_pseudo_Ideal_Main
End Sub

Sub KraBBy_pseudo_Ideal_Main(Optional txt1 As String, Optional txt2 As String)

    Dim oTargetDrw As Inventor.DrawingDocument
    Set oTargetDrw = ThisApplication.ActiveDocument
   
    Dim strSymbolName As String
    strSymbolName = "Teillösung 1"
   
    Dim oSymbolDef As SketchedSymbolDefinition
    Set oSymbolDef = oTargetDrw.SketchedSymbolDefinitions.Item(strSymbolName)
   
    ' Den ganzen Ablauf in eine einzige Rückgängig-Aktion packen
    Dim oTxnMgr As TransactionManager
    Set oTxnMgr = ThisApplication.TransactionManager
    Dim oTxn As Transaction
    Set oTxn = oTxnMgr.StartTransaction(oTargetDrw, "Makro 'Symbol einfügen'") 'Start oTxn
'###########  den Namen noch passend machen! ('Symbol einfügen') #########
    'das sieht der Benutzer beim Rückgängig-Befehl
   
   
    'Sub Aufrufen, mehr oder weniger Teillösung 1
    Call Symb_einfuegen_UserPos(oSymbolDef)
   
   
   
    '--------
    'Symbol(e) mit variablem Text einfügen (nach Teillösung 2)
    ' aber Position von den vorher platzierten verwenden
   
    'Symbol-Definition
    Dim oSketchSymDef As SketchedSymbolDefinition
    Set oSketchSymDef = oTargetDrw.SketchedSymbolDefinitions.Item("Teillösung 2")
   
   
    'PromptStrings (Arraygröße muss der Anzahl angeforderter Eingaben entsprechen!)
    Dim i As Integer, a As Integer
    i = Anzahl_AngefEingabe(oSketchSymDef)  'Aufruf Function, gibt die Anzahl nötiger Eingaben zurück
    Dim asPromptStr() As String
    ReDim asPromptStr(0 To (i - 1))
    For a = 0 To i - 1
        asPromptStr(a) = "" 'Array initialisieren
    Next 'a
    'funktioniert soweit für beliebige Symbole, da sich die Arraygröße anpassst; jedoch sind alle Strings zunächst leer ("")
   
    ' Texte festlegen (falls nicht übergeben)
    If Not txt1 = "" Then asPromptStr(0) = txt1 Else asPromptStr(0) = "hier bla 1"
    If Not txt2 = "" Then asPromptStr(1) = txt2 Else asPromptStr(1) = "hier bla 2"
   
   
    'eingefügte(s) Dummy-Symbol(e) finden
    Dim oCol As ObjectCollection
    Set oCol = Symb_finden(strSymbolName)  'siehe Function unten
   
    'sollte der Benutzer kein Dummy-Symb. eingefügt haben, bleibt die Collection leer
    ' der Rest läuft ohne Fehler durch (es passiert nur nix)
    If 0 = oCol.Count Then  'oder wir prüfen das hier und brechen ab
        MsgBox "Kein Dummy platziert...", vbInformation + vbOKOnly, "Abgebrochen"
        oTxn.Abort  'Rückgängig-Aktion abbrechen (dadurch wird alles seit Start rückgängig gemacht, aber es ist ja auch nix passiert)
        Exit Sub
    End If
   
    Dim oPt As Point2d, oDummySymb As SketchedSymbol
    For Each oDummySymb In oCol    'Schleife durch die Liste mit den gefundenen Dummys
        Set oPt = oDummySymb.Position  'Koordinaten vom Dummy
        Call Symb_einfuegen_Koord(oSketchSymDef, asPromptStr, oPt)  'Symbol einfügen -> siehe Function
        'evtl. wäre es noch gut, die neuen Symbole greifbar zu haben,
        ' dann könnten Sie einer neuen Collection hinzugefügt werden
        ' wie auch in Fuction Symb_finden()
    Next
   
   
    ' Dummy-Symbole wieder löschen
    For i = oCol.Count To 1 Step -1    'könnte man auch mit For Each machen, aber da die Elemente gelöscht werden, mache ich es lieber vom Ende der Liste her
        oCol.Item(i).Delete
    Next i
    oCol.Clear
   
    'Rückgängig-Aktion abschließen
    oTxn.End
   
End Sub

Private Sub Symb_einfuegen_UserPos(oSymbolDef As SketchedSymbolDefinition)
'fügt gegebene Definition als neues Symbol ein
' bzw. startet den Befehl dazu (User platziert dann das Symbol)

    With ThisApplication.ActiveDocument.SelectSet
        Call .Clear
        Call .Select(oSymbolDef)
    End With

    Dim oDef As ControlDefinition
    Set oDef = ThisApplication.CommandManager.ControlDefinitions.Item("DrawingUserDefinedSymbolsQuickCtxCmd")

    Call oDef.Execute2(True)    'mit .Execute würde das Programm einfach weiterlaufen, bevor der User ein Symbol platziert hat
    'so wartet das Makro, bis der User das Platzieren beendet hat
   
End Sub

Private Function Symb_finden(strSymbName As String) As ObjectCollection
'auf dem aktiven Blatt werden die Skizzierten Symbole mit dem gegebenen Namen gefunden
'Rückgabe der gefundenen Symbole als Collection

    'Aktive Zeichnung
    Dim oDoc As DrawingDocument
    Set oDoc = ThisApplication.ActiveDocument
   
    'Aktives Blatt
    Dim oSheet As Sheet
    Set oSheet = oDoc.ActiveSheet
   
    'neue Collection anlegen -> wird am Ende zurückgegeben
    Dim oSymbolCol As ObjectCollection
    Set oSymbolCol = ThisApplication.TransientObjects.CreateObjectCollection
   
    'Schleife durch alle Sk.Symbole auf dem aktuellen Blatt
    Dim oSymb As SketchedSymbol
    For Each oSymb In oSheet.SketchedSymbols
        If oSymb.Name = strSymbName Then    'wenn Name gleich
            Call oSymbolCol.Add(oSymb)      'zur Collection hinzu
        End If
    Next
   
    'Rückgabewert der Function -> Collection mit den gefundenen Symbolen
    Set Symb_finden = oSymbolCol
   
End Function

Private Function Symb_einfuegen_Koord(oSketchedSymbolDef As SketchedSymbolDefinition, sPromptStrings() As String, oPoint2d As Point2d) As SketchedSymbol
' fügt ein neues skizziertes Symbol an gegebenem Punkt ein

    Dim oSheet As Sheet
    Set oSheet = ThisApplication.ActiveDocument.ActiveSheet

    Dim oSketchedSymbol As SketchedSymbol
    Set oSketchedSymbol = oSheet.SketchedSymbols.Add(oSketchedSymbolDef, oPoint2d, 0, 1, sPromptStrings)
   
    'Symbol soll statisch sein (dann keine Griffe zum ändern der Größe)
    oSketchedSymbol.Static = True
   
    'Rückgabewert der Function -> erzeugtes Symbol
    Set Symb_einfuegen_Koord = oSketchedSymbol
   
End Function
   

Private Function Anzahl_AngefEingabe(ByRef oSketchSymDef As SketchedSymbolDefinition) As Integer
    'Anzahl "angeforderter Eingaben" ermitteln
    '
    ' KraBBy 28.5.2018
    '
    Dim sTmp As String, oTB As TextBox
    Dim iCnt As Integer: iCnt = 0
    For Each oTB In oSketchSymDef.Sketch.TextBoxes
        sTmp = oTB.FormattedText
        If InStr(sTmp, "/Prompt") Then iCnt = iCnt + 1
    Next
    'iCnt ist jetzt die gesuchte Anzahl
    Anzahl_AngefEingabe = iCnt    'Rückgabewert
 
    'Aufräumen
    Set oTB = Nothing
End Function

---

Auf dem Formular habe ich einen zusätzlichen Button erstellt

Code:

---

Private Sub B_KraBBy_Click()   
   
    Call KraBBy.KraBBy_pseudo_Ideal_Main(TextBox1.Text, TextBox2.Text)
    '-> siehe Modul KraBBy
   
End Sub

---

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

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

---

@KraBBy,

recht vielen Dank für Deine Mühe. Ich habe INV 2021 auf dem Laptop. Werde es nachher mal ausprobieren.
Der Code ist auf jeden Fall fantastisch. Alles genau beschrieben. Da kann ich noch eine Menge lernen.
Denn werde ich mir auf jeden Fall Schritt für Schritt genau ansehen. Dafür verdienst Du mehr als 10 Punkte.

Viele Grüße Hape

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