Hot News:

Mit Unterstützung durch:

  Foren auf CAD.de
  AutoCAD VBA
  Typefehler mit Mtext einfügen

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
  
Von Digital Twins bis Hochleistungs-Computing: PNY präsentiert seine Zukunftstechnologien für die Industrie von morgen, eine Pressemitteilung
Autor Thema:  Typefehler mit Mtext einfügen (894 mal gelesen)
tomww
Mitglied



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

Beiträge: 37
Registriert: 27.10.2006

erstellt am: 03. Nov. 2006 18:35    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

Hallo,
so langsam kämpfe ich mich in VBA ACAD durch, aber hier wieder was, wo ich doch rätsel:
Ich möchte ein Text in die Zeichnung einfügen.
Hier mit gehts:
Code:

Set textObj = ThisDrawing.ModelSpace.AddText(Flaeche1 & " m2", einfuege, height)

bei dieser Version (die eigentliche) erscheint die Fehlermeldung, aber der Text wird eingetragen. Die Meldung erscheint nach dem Bekantgeben / Auswahl des Einfügepunktes.

Code:

Set textObj = ThisDrawing.ModelSpace.AddMText(einfuege, 0, text)

Das Problem haengt wohl mit der Variablen "einfuege" zusammen, denn beim Debug.Print wird auch gemeckert.
Deklariert habe ich es als Variant.
Habe ich einen Denkfehler?

Den Code habe ich aus diesem Forum zusammen gesucht. Hier die ganze Prozedur:

Code:

Sub Line3(shoehe As Double)
    Dim objTemp As AcadLWPolyline
    Dim varPnt As Variant
    Dim dblTemp(1) As Double
    Dim dblVerts() As Double
    Dim strPrmt As String
    Dim Intcnt As Integer
    Dim pt1 As Variant
    Dim Pt2 As Variant
    Dim PtTemp As Variant
    Dim textObj As AcadText
    Dim height As Double
    Dim einfuege As Variant
    Dim text As String
    'checklayer ("MyFlaeche")
'  On Error GoTo Err_Control
   
  Hauptdialog.Hide 'Userformular muss während der Arbeit ausgeblendet werden
   
    pt1 = ThisDrawing.Utility.GetPoint(, vbCrLf & "Bitte den Startpunkt wählen: ")
    'Pt2 = ThisDrawing.Utility.GetPoint(, vbCrLf & "bis Punkt: ")
    Pt2 = pt1
        ReDim dblVerts(3)
        dblVerts(0) = pt1(0)
        dblVerts(1) = pt1(1)
        dblVerts(2) = Pt2(0)
        dblVerts(3) = Pt2(1)
           
            Set objTemp = ThisDrawing.ModelSpace.AddLightWeightPolyline(dblVerts)
      Intcnt = 1
    PtTemp = Pt2
    'objTemp.Layer = "MyFlaeche"
    On Error GoTo Flaeche
Do
    Intcnt = Intcnt + 1
    varPnt = ThisDrawing.Utility.GetPoint _
                (ThisDrawing.Utility.TranslateCoordinates(PtTemp, acWorld, acUCS, False), _
                vbCrLf & "bis Punkt: ")
    dblTemp(0) = varPnt(0)
    dblTemp(1) = varPnt(1)
    objTemp.AddVertex Intcnt, dblTemp
   
   
    'objTemp.color = acYellow
    objTemp.Update
    PtTemp = varPnt
   
Loop
   
Flaeche:
    If Intcnt < 3 Then GoTo Err_Control
    objTemp.Closed = True
   
    'objTemp.color = acYellow
    ' objTemp.Update
   
    Dim Flaeche1 As Double
   
    Flaeche1 = objTemp.Area
    ' nur zwei Kommastellen
    'Flaeche1 = Format(Flaeche1, "0." & String(ThisDrawing.GetVariable("LUPREC"), "0"))
       
        Flaeche1 = Format(Flaeche1, "##,##0.00")
       
        MsgBox "Fläche: " & Flaeche1 & " m²", , "GetEntity Example"

   
    'Schriftgröße
    height = shoehe
    text = Flaeche1 & " m2"
    einfuege = ThisDrawing.Utility.GetPoint(, "Bitte den Einfügepunkt wählen")
    'Texteinbauen

    'Set textObj = ThisDrawing.ModelSpace.AddText(Flaeche1 & " m2", einfuege, height)
  Set  textObj = ThisDrawing.ModelSpace.AddMText(einfuege, 0, text)
    textObj.height = height
    'ThisDrawing.ModelSpace.AddText(Flaeche1 & " m2", einfuege, height)
    'ThisDrawing.ModelSpace.AddMText(einfuege,0,text)
   
   
        textObj.Layer = ThisDrawing.ActiveLayer.Name
       
        textObj.Update
        Err.Clear
       
       
    '#---------------------------
   
    Hauptdialog.Show    'wieder einblenden der userform
 
Exit_Here:
Set objTemp = Nothing
Set textObj = Nothing

    Exit Sub
Err_Control:
    ThisDrawing.Utility.Prompt vbCrLf & "Zu wenig Punkte für Flächenberechnung!" & vbCrLf
    Resume Exit_Here
   
End Sub


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

tomww
Mitglied



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

Beiträge: 37
Registriert: 27.10.2006

erstellt am: 03. Nov. 2006 20:06    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

Autsch, habe selbst den Bockmist verursacht:

habe vergessen den Objekt richtig zu deklarieren:

Dim textObj As AcadText
  anstatt
Dim textObj As AcadMText

mea culpa 

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)2025 CAD.de | Impressum | Datenschutz