---

Hallo,

nachdem ich eine Weile vergeblich gesucht habe, nun doch mein Hilferuf an dieser Stelle.
Ich möchte überschriebene Bemaßungen über einen Suchlauf ausfindig machen und durch umfärben der Maßzahl oder Layerwechsel kenntlich machen. Ich weiß es gibt dafür eine Routine in Lisp, die kann ich aber nicht mehr finden.
Und da ich gern in VBA etwas dazu lernen möchte, würde ich gerne wissen wie man hier ansetzen könnte.

Mfg
Paul

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

---

Abend Paul,

mal nur als simpler Ansatz, um ein TextOverride zu erkennen:

Code:

---

Sub qwe()
    Dim x As AcadEntity
    For Each x In ThisDrawing.ModelSpace
        If TypeName(x) = "IAcadDimRotated" Then
            If x.TextOverride <> "" Then x.color = acRed
        End If
    Next
End Sub

---

Performanter/Eleganter wird das ganze mit Filtern der Bemassungen,
hab' den für die Dimensions grade nicht im Schädel;-)
Aber gugg mal die Suche ..., dann wird perfekt;-)

Gruss, Nancy

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

---

Hallo Nancy,

vielen Dank für die schnelle Hilfe.
Das hilft mir schon sehr weiter. Da ich aus 2D-Zeichnungen von vielen Zulieferern 3D-Modelle erstelle ist eine schnelle Prüfung gefäkter Maße eine große Hilfe.
Leider gibt es aber auch Überschreibungen die trotzdem assotiativ sind z.B. "%%c<>". Könnte man so etwas auch filtern?

MfG
Paul

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

---

Hallo Paul,

Wenn die Textüberscheibungen, wie "%%C<>" nicht gefunden werden, müsste es sich um ein Textprefix handeln. Diese kannst du nach Nancy`s Ansatz über if x.textprefix <> "" then... rausfischen.
Allerdings solltest du hier mit Filtern arbeiten, da das IMHO schneller abläuft, als wenn du jedes Element der Zeichnung durchlaufen musst.

Gruß, Carsten

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

---

Hallo Carsten,

nee Prefix habe ich nicht gemeint. Durch die Überschreibung des Bemaßungstextes mit "<>" bleibt die Bemaßungszahl assotiativ und bräuchte nicht als Überschreibung erkannt werden. Ich benutze das um z.B. ein Durchmesserzeichen vor der Maßzahl einzufügen (%%c<> )

MfG
Paul

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

---

Hallo Paul,

Wenn es kein Prefix ist, dann wird es doch mit Nancy'S Beiespiel auch herausgefiltert, da dort ja nur kontrolliert wird, ob eine Textüberschreibung vorhanden ist, oder nicht.

Gruß, Carsten

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

---

Hallo Carsten,

ja das Programm erkennt die Textüberschreibung. Da Überschreibungen mit den Zeichen <> (kann irgendwo im Text auftauchen)immer auch die Korrkte Maßzahl wiedergeben, sollte das Tool diese nicht als Überschreibung kennzeichnen. Es müsste also ein Suchlauf eingebunden werden, der Text auf das Vorhandensein genau diese Zeichenfolge hin analysiert.

MfG
Paul

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

---

Hallo.

Man könnte doch den gesamten Inhalt in einen String übergeben und diesen dann durchsuchen, ob "<>" darin enthalten ist?

Grüsse
Lappi

------------------
die EDV (weibl.)...ansonsten wäre die Kommunikation mit Computern und deren angeschlossenen Geräte in einer für jederMann verständlichen Sprache...

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

---

Hallo Paul,

Um zu überprüfen, ob die Maßüberschreibung den String "<>" enhält kannst du die funktion instr verwenden.

Hier ein kleines Beispiel:

Public Sub AA()
Dim a$ , a$
a = "Dieser Text enhält das Wort 'Test'"
b = "test"
If InStr(a, b) Then
MsgBox "Hallo"
End If
End Sub

Gruß, Carsten

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

---

Hallo,

anbei nun für alle Interessierten das fertige Macro:

Sub BEMMANI()

    Dim Ele As AcadEntity
    Dim Suchtext As String
   
    Suchtext = "<>"
   
    For Each Ele In ThisDrawing.ModelSpace
        If TypeName(Ele) = "IAcadDimRotated" Then
            If Ele.TextOverride <> "" Then
                If InStr(Ele.TextOverride, Suchtext) Then
                    Ele.color = acRed
                Else
                    Ele.color = acGreen
                End If
            End If
        End If
    Next
End Sub

Auf die Verwendung eines Bemaßungsfilters bin ich nicht hier nicht eingegangen. Ich bin immer schon froh wenn die Makros machen was sie sollen. Auch habe ich das Gefühl das ganze zu sehr verschachtelt zu haben, aber wie gesagt, es macht was es soll.

Ich Danke allen Helfern und Wünsche alles Gute

Paul

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