Code:
'KraBBy 10.05.2021Option 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
Foren auf CAD.de (alle Foren)
| 
