| |  | 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

 Beiträge: 37 Registriert: 27.10.2006
|
erstellt am: 03. Nov. 2006 18:35 <-- editieren / zitieren --> Unities abgeben:         
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

 Beiträge: 37 Registriert: 27.10.2006
|
erstellt am: 03. Nov. 2006 20:06 <-- editieren / zitieren --> Unities abgeben:         
|
| Anzeige.:
Anzeige: (Infos zum Werbeplatz >>)
 |