| | | Gut zu wissen: Hilfreiche Tipps und Tricks aus der Praxis prägnant, und auf den Punkt gebracht für Autodesk Produkte | | | | PNY bietet das umfangreichste Ökosystem von B2B als auch B2C-Lösungen für IT-Akteure auf dem Markt, eine Pressemitteilung
|
Autor
|
Thema: Text auf Objekt drehen (1917 mal gelesen)
|
TLieske Mitglied Bauingenieur
Beiträge: 247 Registriert: 12.07.2002 18xAutoCAD, SofiCAD, Vestra, AutoTURN, WinXP_Prof(SP3), PIV-3, 4GBRAM, 2xHP1050C, CARD1, Microstation, AutoVUE ...
|
erstellt am: 10. Sep. 2002 12:31 <-- editieren / zitieren --> Unities abgeben:
Hallo liebe LISP-Gemeinde, ich suche einen Befehl der folgendes macht: Text auf Objekt drehen: Text(e) wählen Quellobjekt für Drehung picken (z.B. Linie) Dann sollen sich alle angewählten Elemente in dem Winkel drehen wie das Quellobjekt. Ich habe bei cadwiesel, Expresstools und div. anderen CAD-Homepages geschaut, aber nix (kostenloses) gefunden. Bevor ich mich also einen halben Tag halb frustriert hinsetze (bin eben nicht der Lisp-Profi, trotzdem erhalte ich dann das gewünschte Ergebnis): Hat da jemand was fertiges? In Augustus VISIO gab's so was, kann ich aber eben nicht rausfiltern. Bin jetzt SofiCAD-Anwender und da gibt es sowas nicht. Brauche ich leider ständig. DANKE EUCH ALLEN IM VORAUS. 10 Unities... ------------------ Thomas Lieske Schüßler-Plan Ing.-GmbH Frankfurt-Sachsenhausen Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
Brischke Ehrenmitglied V.I.P. h.c. CAD on demand GmbH
Beiträge: 4187 Registriert: 17.05.2001 AutoCAD 20XX, defun-tools
|
erstellt am: 10. Sep. 2002 15:00 <-- editieren / zitieren --> Unities abgeben: Nur für TLieske
|
UJJ Mitglied
Beiträge: 190 Registriert: 05.03.2002
|
erstellt am: 10. Sep. 2002 15:06 <-- editieren / zitieren --> Unities abgeben: Nur für TLieske
Hast du es schon mal mit dem Befehl "ausrichten" probiert? Ist zwar kein LISP, sondern ein eingebauter Befehl und wenn man Text ausrichten will, muss man Ofang Basispunkt und Objektfangspur arbeiten. Gruss Uwe [Diese Nachricht wurde von UJJ am 10. September 2002 editiert.] Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
RoSiNiNo Mitglied Konstrukteur
Beiträge: 1126 Registriert: 09.10.2002 Autodesk Building Design Suite Premium 2021 Windows 10 Pro 64bit HP Workstation Z620, 24GB GeForce GTX 970
|
erstellt am: 10. Sep. 2002 15:52 <-- editieren / zitieren --> Unities abgeben: Nur für TLieske
Zitat: Original erstellt von TLieske: ich suche einen Befehl der folgendes macht: Text auf Objekt drehen: Text(e) wählen Quellobjekt für Drehung picken (z.B. Linie)
Hallo Thomas, hab das mal in VBA programmiert, hoffe es funktioniert bei dir. Es zentriert Texte und MTexte auf Linien und Kreisbögen. Die Richtung ist von der Linienrichtung abhängig.
Code:
' Zentriert Text oder MText mit constAbstand and Linie Public Sub TextLinieZentrieren() Dim Elem As AcadEntity Dim PtT As Variant Dim Elem2 As AcadEntity Dim PtL As Variant Dim objText As AcadText Dim objMText As AcadMText Dim EPText(2) As Double Dim objLinie As AcadLine Dim objLinie2 As AcadLine Dim objArc As AcadArc Dim objArc2 As AcadArc Dim Obj As Variant Dim objLinArc As AcadLine Dim intLinArc As Variant Dim Abstand As Double Do MTextText: On Error Resume Next ThisDrawing.Utility.GetEntity Elem, PtT, "Text/MText wählen: " If Err Then Exit Sub If Elem.EntityType = acMtext Or Elem.EntityType = acText Then Elem.Highlight True Abstand = Elem.height / 2 Else GoTo MTextText End If LinieBogen: On Error Resume Next ThisDrawing.Utility.GetEntity Elem2, PtL, "Linie/Bogen wählen: " If Err Then Elem.Highlight False Exit Sub End If Select Case Elem2.EntityType Case acLine Set objLinie = Elem2 Elem.Rotation = ThisDrawing.Utility.AngleFromXAxis(objLinie.startPoint, objLinie.endPoint) Obj = objLinie.offset(Abstand) Set objLinie2 = Obj(0) EPText(0) = (objLinie2.startPoint(0) + objLinie2.endPoint(0)) / 2 EPText(1) = (objLinie2.startPoint(1) + objLinie2.endPoint(1)) / 2 EPText(2) = (objLinie2.startPoint(2) + objLinie2.endPoint(2)) / 2 objLinie2.Delete Case acArc Set objArc = Elem2 EPText(0) = (objArc.startPoint(0) + objArc.endPoint(0)) / 2 EPText(1) = (objArc.startPoint(1) + objArc.endPoint(1)) / 2 EPText(2) = (objArc.startPoint(2) + objArc.endPoint(2)) / 2 Elem.Rotation = ThisDrawing.Utility.AngleFromXAxis(objArc.endPoint, objArc.startPoint) Obj = objArc.offset(Abstand) Set objArc2 = Obj(0) Select Case ThisDrawing.ActiveSpace Case Is = 0 Select Case ThisDrawing.MSpace Case True Set objLinArc = ThisDrawing.ModelSpace.AddLine(objArc.Center, EPText) Case False ' Arbeiten wir im PaperSpace wird der Block in mm Eingesetzt Set objLinArc = ThisDrawing.PaperSpace.AddLine(objArc.Center, EPText) End Select Case Is = 1 Set objLinArc = ThisDrawing.ModelSpace.AddLine(objArc.Center, EPText) End Select intLinArc = objArc2.IntersectWith(objLinArc, acExtendOtherEntity) EPText(0) = intLinArc(0) EPText(1) = intLinArc(1) EPText(2) = intLinArc(2) objLinArc.Delete objArc2.Delete Case Else GoTo LinieBogen End Select Select Case Elem.EntityType Case acText Set objText = Elem objText.Alignment = acAlignmentCenter objText.TextAlignmentPoint = EPText Case acMtext Set objMText = Elem objMText.AttachmentPoint = acAttachmentPointBottomCenter objMText.insertionPoint = EPText End Select Loop End Sub
------------------ Roland Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
StephanJP Mitglied CAD-Admin
Beiträge: 834 Registriert: 09.11.2000
|
erstellt am: 10. Sep. 2002 16:22 <-- editieren / zitieren --> Unities abgeben: Nur für TLieske
Hallo Thomas, habe auch mal 'nen Lisp programmiert: (defun C:TDA() (setq tau (nentsel "\nAusrichtende Linie auswählen: ")) (setq tausel (entget (car tau))) (cond ((= (cdr (assoc 0 tausel)) "VERTEX")(setq pt1 (osnap (cadr tau) "_mid"))) ((= (cdr (assoc 0 tausel)) "LWPOLYLINE")(setq pt1 (osnap (cadr tau) "_mid"))) ((= (cdr (assoc 0 tausel)) "LINE")(setq pt1 (osnap (cadr tau) "_mid"))) (T (alert "An diesem Element kann nicht ausgerichtet werden!")(exit)) ) (setq ten (car (entsel "\nAuszurichtendes Textelement auswählen: "))) (while ten (setq pt2 (osnap (cadr tau) "_end")) (setq tel (entget ten)) (setq tw (angle pt1 pt2)) (setq tel (subst (cons 50 tw)(assoc 50 tel) tel)) (entmod tel) (entupd ten) (initget 128 "Ja Nein") (setq kwort (getkword "\nText um 180ø drehen? J/<N>: ")) (if kwort (setq kwort kwort)(setq kwort "Nein")) (if (wcmatch kwort "J*") (progn (setq tw (+ tw pi)) (setq tel (subst (cons 50 tw)(assoc 50 tel) tel)) (entmod tel) (entupd ten) ) ) (setq tau (nentsel "\nAusrichtende Linie auswählen: ")) (setq tausel (entget (car tau))) (cond ((= (cdr (assoc 0 tausel)) "VERTEX")(setq pt1 (osnap (cadr tau) "_mid"))) ((= (cdr (assoc 0 tausel)) "LWPOLYLINE")(setq pt1 (osnap (cadr tau) "_mid"))) ((= (cdr (assoc 0 tausel)) "LINE")(setq pt1 (osnap (cadr tau) "_mid"))) (T (alert "An diesem Element kann nicht ausgerichtet werden!")(exit)) ) (setq ten (car (entsel "\nAuszurichtendes Textelement auswählen: "))) ) ; end while ) Allerdings musst Du die Texte einzeln anfassen und noch bestätigen, ob er "richtig herum" steht. ------------------
gruß stephan Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
TLieske Mitglied Bauingenieur
Beiträge: 247 Registriert: 12.07.2002 18xAutoCAD, SofiCAD, Vestra, AutoTURN, WinXP_Prof(SP3), PIV-3, 4GBRAM, 2xHP1050C, CARD1, Microstation, AutoVUE ...
|
erstellt am: 10. Sep. 2002 16:27 <-- editieren / zitieren --> Unities abgeben:
@Brischke: 10 Points to Saarland Ist zwar ein wenig viel mit dem Abstand und an den Linien anfang, aber es ist erstmal eine Lösung. Ich wollte lediglich die Winkelübernahme in die Eigenschaften des Textes übertragen. Leider ist im Eigenschaften-Fenster der Winkel einer gepickten Linie grau hinterlegt. Sonst hätte man das ja einfach per Zwischenablage auf den Text übertragen können. Aber die Autodesk-Fritzen müssen sich ja noch ein Hintertürchen für ein Update offen halten.... @UJJ: Ich kam damit ja gar nicht zurecht (auf dem ersten Blick). Und mit Objektfangspur arbeite ich eigentlich gar nicht, da meine normalen Objektfänge mir bisher total ausreichten. @RosiNiNo: Du warst leider der Dritte. Aber das ist ähnlich wie bei Brischke. @Alle: Lob an Alle für die Mühe. Trotzdem: Geht's auch in der einfachen Version, wie von mir bei @Brischke beschrieben? Also lediglich Winkelübernahme? ------------------ Thomas Lieske Schüßler-Plan Ing.-GmbH Frankfurt-Sachsenhausen Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP |
TLieske Mitglied Bauingenieur
Beiträge: 247 Registriert: 12.07.2002 18xAutoCAD, SofiCAD, Vestra, AutoTURN, WinXP_Prof(SP3), PIV-3, 4GBRAM, 2xHP1050C, CARD1, Microstation, AutoVUE ...
|
erstellt am: 11. Sep. 2002 07:54 <-- editieren / zitieren --> Unities abgeben:
|
Erik Mitglied
Beiträge: 81 Registriert: 14.02.2002 PIIII, 2.6 GHz, 512 MB RAM, Matrox G550 XP Professional SP 1 AutoCAD Map 2004 Canalis, Plateia, QuickSurf HP Designjet 1050C
|
erstellt am: 11. Sep. 2002 14:43 <-- editieren / zitieren --> Unities abgeben: Nur für TLieske
|
marc.scherer Ehrenmitglied V.I.P. h.c. CAD-Administrator
Beiträge: 2494 Registriert: 02.11.2001 Windows 10 64bit AutoCAD Architecture 2018/2019 (deu/eng) AEC-Collection 2019 (Revit und Zeugs) Wenn sich's nicht vermeiden läßt: D-A-CH Erweiterung (mies implementierter Schrott)
|
erstellt am: 12. Sep. 2002 08:10 <-- editieren / zitieren --> Unities abgeben: Nur für TLieske
|
| Anzeige.:
Anzeige: (Infos zum Werbeplatz >>)
|