---

Liebes Forum,

ich versuche eine Multiführungsline mittels VBA in den Modellbereich einzufügen.
Das klappt auch alles, aber füge ich die MFLinie mit MText an einer bestimmten Stellen in Bezug auf den Einfügepunkt der Pfeilspitze ein, verhüpft der Text und wird an einer anderen Stelle als den übergebenen Koordinaten des Texteinfügepunkts eingefügt.
Es muss an der Länge des Textes liegen und, ob ACAD meint, die Führungsline muss jetzt auf der rechten Seite angefügt werden.

Ich möchte den Text aber genau an der Stelle einfügen, die ich angeklickt habe.
Die Koordinaten werden also richtig übergeben und danach verhüpft der Text.
Weiß jemand, nach welchen Kriterien der Text verschoben wird, bzw. die Führungslinie die Seite wechselt?
Oder wie die Parameter dazu heißen?
Oder kann man das wechseln der Seite der MFLinie verhindern und eine Seite erzwingen?

------------------
Grüße aus München
Christian

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

---

Lade dein funktionierendes VBA Codeschnipsel und eine Beispeilzeichnung zum Nachvollziehen hier hoch, dann können deine Fragen sicher beantwortet werden.

------------------
Mit freundlichem Gruß

Udo Hübner
www.CAD-Huebner.de

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

---

Blk2MF_210426-1.dwg

Hallo Udo,

hier der Code.
Ich habe den Fehler soweit eingegrenzt, dass es am MF-Stil liegen muss.
Dieser lässt ich nicht in eine neue Zeichnung über das DC einfügen.
Somit ist die Frage erledigt.

Aber ich habe noch eine strukturelle Frage.
Wie kann ich zusätzlich zu ESC auch auf die rechte Mousetaste (Sub beenden) beim Abbruch reagieren?
Und wie reagiere ich auf die rechte Mousetaste beim Richtungswinkel (Winkel übernehmen)?

Code:

---

Sub Blk2MLeader2()
    ' Blockreferenz mit dem Attribut WERT umwandeln in Multiführungstext.
    ' Einfügepunkt des Textes und Textrichtung wählen.
   
    ' Ablauf:
    ' Blockreferenz anklicken.
    ' Der Block muss ein Attribut WERT haben.
    ' Einfügepunkt des Blocks auslesen
    ' MF am Einfügepunkt des Blocks einfügen
    ' und neue Position und Richtung für den Text angeben.
   
    Dim returnObj As AcadObject, basePnt As Variant, baseAlignment As Double, varAtt As Variant
    Dim retAngle As Double, strWert As String
    Dim iKeyCode
    Dim intI As Integer
   
    Dim MLeaderObj As AcadMLeader
    Dim points(0 To 5) As Double
    Dim Epkt As Variant

    Dim strStyle As String
    strStyle = "MP_25_Fläche_M250"
   
    'Abfrage, ob Positionsnummer ausgegeben werden soll
    On Error Resume Next
   
RETRY:
    Set basePnt = Nothing
    Set returnObj = Nothing
    Set varAtt = Nothing
    Set Epkt = Nothing
    strWert = ""
   
    ThisDrawing.Utility.GetEntity returnObj, basePnt, "Block mit Attribut WERT wählen:"
    iKeyCode = GetAsyncKeyState(&H1B)  ' abfragen, ob ESC oder die rechte Mousetaste gedrückt wurde
    'Hier soll auch auf die rechte Mousetaste reagiert werden.
    'Wie fragt man das ab?
           
    If Err <> 0 Then
        Err.Clear
        If (iKeyCode And &H1B) = 1 Then 'Abbruch mit Taste "Esc"
            Exit Sub
        Else 'ins Leere geklickt
            GoTo RETRY
        End If
    Else
        'Einfügepunkt des Objekts ermitteln.
        'Prüfen, ob es ein Block ist
        If TypeOf returnObj Is AcadBlockReference Then
            'Prüfen, ob der Block Attribute hat
            If returnObj.HasAttributes Then
                'Das Attribut WERT auslesen
                varAtt = returnObj.GetAttributes()
                For intI = LBound(varAtt) To UBound(varAtt)
                    If varAtt(intI).TagString = "WERT" Then
                        strWert = varAtt(intI).TextString
                    End If
                Next
            End If
           
            'An diesem Pkt wird die MF eingefügt.
            basePnt = returnObj.InsertionPoint
           
            'Richtungswinkel des Objekts ermitteln
            baseAlignment = returnObj.Rotation
           
            'MF einfügen
            ' Einfügepunkt des Textes abfragen
            Epkt = ThisDrawing.Utility.GetPoint(, "Einfügepunkt des Textes angeben:")
                       
           
            'Vorbelegen der Textrichtung mit der Rotation des Blocks
            retAngle = returnObj.Rotation
            'Abfragen der Textrichtung
            retAngle = ThisDrawing.Utility.GetAngle(Epkt, "Richtung eingeben, oder ENTER für Richtung des Blocks übernehmen: ")
            'Hier soll auf die rechte Mousetaste reagiert werden.
            'Wie fragt man das ab?
           
            points(0) = basePnt(0): points(1) = basePnt(1): points(2) = basePnt(2)
            points(3) = Epkt(0): points(4) = Epkt(1): points(5) = Epkt(2)
           
            Set MLeaderObj = ThisDrawing.ModelSpace.AddMLeader(points, 0)
            With MLeaderObj
                .StyleName = strStyle
                .TextString = strWert
                .TextRotation = retAngle 'Schreibrichtung des Textes angeben
            End With
           
            MLeaderObj.Update
           
            'Löschen des angeklickten Blocks
            'returnObj.Delete
           
        Else
            MsgBox "Diese Funktion benötigt einen Block, der das Attribut WERT.", vbInformation, "Hinweis"
        End If

    End If
    GoTo RETRY 'Fragt nach dem nächsten Objekt
End Sub

---

Schon mal vielen Dank für die Hilfe.

------------------
Grüße aus München
Christian

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

---

Hallo Christian,
gerade zufällig gesehen, deshalb die späte Antwort.
Eine Liste der Schlüssel findest Du hier. Rechte Maustaste wäre Code 0x02.
Grüße
Klaus 

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