---

Unbenannt.png

Hallo zusammen,
ich möchte eine Funktion schreiben, die beim Speichern überprüft, ob irgendwelche Bemaßungen (vorerst) in den Schriftkopf ragen.
Ich habe bereits ein AddIn (für andere Funktionen) in welches ich das problemlos integrieren kann, weshalb der Aufruf kein Problem darstellt.
Mein Problem ist, die Führungslinien zu ermitteln. Diese kann ich beim besten willen nirgens finden, hat hier jemand rat?
Das in der Abbildung gelb markierte habe ich bereits, das rosa markierte fehlt mir noch.

Gruß DerBrain87

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

---

Hallo DerBrain87,

ich fürchte die RangeBox für die Bemaßung wirst du selbt berechnenen / annähern müssen. Um alle Fälle möglicher Bemaßungen abzudecken dürfte sich das jedoch als recht aufwendig erweisen.

Grüße

EIBe 3D

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

---

Hallo ElBe,
wie in dem beigefügten Bild zu erkennen ist, hab ich die Führungslinien, sowie den Text schon ganz gut (für alle Bemaßungstypen) ganz gut erfasst.
Leider fehlen die Führungslinien. Dummerweise habe ich bisher auch keine Eigenschaft gefunden, in welcher mir Inventor sagt, wo Linien über die Führungslinien herausragen und wo nicht:-(

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

---

Zitat:

---

...Leider fehlen die Führungslinien. ...

---

Ich denke du meinst die Maß- bzw. Pfeillinien.

Dafür scheint es keine Eigenschaft im Bemaßungsobjekt zu geben. Dies ist in den Bemaßungsstilen mittels der Textbox des Maßes fest "verdrahtet" (hab mich da auch schon mit rumgeärgert)

Eine annähernde Rangebox sollte sich aus Maßhilfslinie 1/2 Start/Endpunkt sowie der Rangebox Bemaßungstext MaxPoint/MinPoint plus Aufschlag berechnen lassen. Leider lässt sich darüber der zweite Maßpfeil gegenüber des Maßes nicht erfassen wenn er außerhalb der Maßhilfslinien liegt. Dies könnte über einen Aufschlag auf der gegenüberliegenden Seite des Maßtextes berücksichtigt werden. Dummerweise kannst du nicht abfragen ob der Pfeil innen oder aussen der Maßlinie ansetzt, da First/SecondArrowheadInside nicht absolut ist sondern nur die Option zum Umstellen zeigt welche auch nur greift wenn der Platz zwischen den Maßhilfslinien ausreicht. Demnach müsstest du den absoluten Abstand zwischen den Maßhilfslinien berechnen und ermitteln ab welchem Abstand die Pfeile "umspringen"

Weiter benötigst du eine Fallunterscheidung für die verschiedenen Maßtypen um z.B. Radienbemaßungen oder Winkelbemaßungen anders zu behandeln.

Edit: Ergänzungen

[Diese Nachricht wurde von EIBe 3D am 15. Jan. 2021 editiert.]

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

---

Hallo

Ich glaube, dass könnte sehr viel einfacher lösbar sein. Als Benutzer würde ich ein Kreuzenfenster über das Schriftfeld ziehen und hätte alle Objekte ausgewählt, die ins Schriftfeld ragen. Das kann man auch per VBA simulieren. Das größte Problem ist herauszufinden wie man die Eckpunkte des Schriftfeldes in Bildschirmkoordinaten umwandelt. Bisher schaut es so aus, als würde es funktionieren. 
Es gibt gelegenlich scheinbar ein Timingproblem, dann erscheint die Messagebox nicht. Bin mir noch nicht sicher, ob das die Zeit für den Übergang der Ansicht beim Zoomen auslöst oder etwas anderes.

Code:

---

Option Explicit

Public Declare PtrSafe Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Public Declare PtrSafe Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dX As Long, ByVal dY As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)

Public Const MOUSEEVENTF_MOVE = &H1
Public Const MOUSEEVENTF_LEFTDOWN = &H2
Public Const MOUSEEVENTF_LEFTUP = &H4

Public Sub FindTitleBlockCollidingObjects()
'Prüft ob irgendwas ins Schriftfeld ragt.

Dim oApp As Inventor.Application
Set oApp = ThisApplication

Call oApp.ActiveView.Fit(True)

DoEvents

Dim oDrawDoc As DrawingDocument
Set oDrawDoc = oApp.ActiveDocument

Dim oSheet As Sheet
Set oSheet = oDrawDoc.ActiveSheet

Dim oView As View
Set oView = oDrawDoc.Views.Item(1)

Dim oCamera As Camera
Set oCamera = oView.Camera

Dim oTitleBlock As TitleBlock
Set oTitleBlock = oSheet.TitleBlock

Dim XFrom As Long
Dim YFrom As Long
Dim dX As Long
Dim dY As Long

Dim oTBPoint1 As Inventor.Point
Set oTBPoint1 = oApp.TransientGeometry.CreatePoint(oTitleBlock.RangeBox.MaxPoint.x, oTitleBlock.RangeBox.MaxPoint.y, 0)

Dim oTBPoint2D1 As Point2d
Set oTBPoint2D1 = oCamera.ModelToViewSpace(oTBPoint1)

Dim oTBPoint2 As Inventor.Point
Set oTBPoint2 = oApp.TransientGeometry.CreatePoint(oTitleBlock.RangeBox.MinPoint.x, oTitleBlock.RangeBox.MinPoint.y, 0)

Dim oTBPoint2D2 As Point2d
Set oTBPoint2D2 = oCamera.ModelToViewSpace(oTBPoint2)

XFrom = oTBPoint2D1.x + oView.Left
YFrom = oTBPoint2D2.y + oView.Top

dX = oTBPoint2D2.x + oView.Left
dY = oTBPoint2D1.y + oView.Top

Dim oSelSet As SelectSet
Set oSelSet = oDrawDoc.SelectSet

Call oSelSet.Clear

Call MouseWindowSelectSim(XFrom, YFrom, dX, dY)

DoEvents

If oSelSet.Count > 0 Then
    MsgBox "Da ragt was ins Schriftfeld."
End If

End Sub

Private Sub MouseWindowSelectSim(ByVal XFrom As Long, ByVal YFrom As Long, ByVal dX As Long, ByVal dY As Long)
'Simuliert eine Kreuzen-Fensterauswahl mit der Maus
   
    SetCursorPos XFrom, YFrom
    mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
    mouse_event MOUSEEVENTF_MOVE, dX, dY, 0, 0
    SetCursorPos dX, dY
    DoEvents
    mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
End Sub 

---

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

RKW Solutions GmbH
www.RKW-Solutions.com

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

---

Leider geil!
Auf die Idee mit dem alles markieren bin ich nicht gekommen, klingt aber echt super!
Das du gleich die vollständige Musterlösung angibst ist auch top. Am liebsten würde ich dir da jetzt nicht 10 sondern 20 Punkte für geben:-)
Wird gleich umgesetzt.
DANKE!!!

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

---

Chapeau Ralf!

Sehr elegant gelöst.

Insgesamt ist der Thread damit auch ein gutes Beispiel zur Verdeutlichung der Begrifflichkeiten "problemorientiert" vs. "lösungsorientiert" 

Auch von mir 10Üs

@DerBrain87:

du kannst auch 20Üs geben. Neben der Ü-Skala gibts noch den Button 10+ 

Grüße

EIBe 3D

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