Hot News:

Unser Angebot:

  Foren auf CAD.de (alle Foren)
  AutoCAD VBA
  Multiführungsline verhüpft beim einfügen mit VBA

Antwort erstellen  Neues Thema erstellen
CAD.de Login | Logout | Profil | Profil bearbeiten | Registrieren | Voreinstellungen | Hilfe | Suchen

Anzeige:

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen nächster neuer Beitrag | nächster älterer Beitrag
  
Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für Autodesk Produkte
Autor Thema:  Multiführungsline verhüpft beim einfügen mit VBA (395 mal gelesen)
otm
Mitglied
Bauingenieur


Sehen Sie sich das Profil von otm an!   Senden Sie eine Private Message an otm  Schreiben Sie einen Gästebucheintrag für otm

Beiträge: 142
Registriert: 26.08.2009

MS Win 10
AutoCAD Civil 3D 2019.3.2 Update
VBA Enabler 2019
MS Access Database Enginge X64
MSO 2016 (64bit)

erstellt am: 24. Apr. 2021 22:05    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

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

CAD-Huebner
Ehrenmitglied V.I.P. h.c.
Verm.- Ing., ATC-Trainer



Sehen Sie sich das Profil von CAD-Huebner an!   Senden Sie eine Private Message an CAD-Huebner  Schreiben Sie einen Gästebucheintrag für CAD-Huebner

Beiträge: 9691
Registriert: 01.12.2003

AutoCAD 2.5 - 2022, LDD, MDT, RD, ADT, Civil
Inventor AIP 4-11, 2008 -2022
Win 10

erstellt am: 25. Apr. 2021 11:03    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für otm 10 Unities + Antwort hilfreich

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

otm
Mitglied
Bauingenieur


Sehen Sie sich das Profil von otm an!   Senden Sie eine Private Message an otm  Schreiben Sie einen Gästebucheintrag für otm

Beiträge: 142
Registriert: 26.08.2009

MS Win 10
AutoCAD Civil 3D 2019.3.2 Update
VBA Enabler 2019
MS Access Database Enginge X64
MSO 2016 (64bit)

erstellt am: 26. Apr. 2021 08:39    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities


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

KlaK
Ehrenmitglied V.I.P. h.c.
Dipl. Ing. Vermessung, CAD- und Netz-Admin



Sehen Sie sich das Profil von KlaK an!   Senden Sie eine Private Message an KlaK  Schreiben Sie einen Gästebucheintrag für KlaK

Beiträge: 2422
Registriert: 02.05.2006

AutoCAD LandDesktop R2 bis 2004
Civil 3D 2005 - 2020
Plateia, Canalis
Visual Basic

erstellt am: 15. Jul. 2021 12:15    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für otm 10 Unities + Antwort hilfreich

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

Anzeige.:

Anzeige: (Infos zum Werbeplatz >>)

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen

nächster neuerer Beitrag | nächster älterer Beitrag
Antwort erstellen


Diesen Beitrag mit Lesezeichen versehen ... | Nach anderen Beiträgen suchen | CAD.de-Newsletter

Administrative Optionen: Beitrag schliessen | Archivieren/Bewegen | Beitrag melden!

Fragen und Anregungen: Kritik-Forum | Neues aus der Community: Community-Forum

(c)2021 CAD.de | Impressum | Datenschutz