---

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

---

Hallo Thomas,

schau mal bei http://www.industrie24.com/i24/pages/mp.php?getpage=ftp&se=D&block=50

Das Programm TAL richtet Text an Linien aus. Ist es das, was du suchst?

Grüße Holger

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

---

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

---

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

---

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

---

@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

---

@Stephan: Das ist EXAKT das, was ich suchte! Vielen Dank!

------------------
Thomas Lieske
Schüßler-Plan Ing.-GmbH
Frankfurt-Sachsenhausen

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

---

Hallo Stephan.
Habe mir Deine LISP auch geholt, die Idee den Text gleich zu drehen ist zusätzlich ein Hit.

Danke

------------------
Erik

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

---

Hi,
und noch 'n Lösungsansatz....
Download von TXT_SET.LSP:
http://www.industrie24.com/ftp.php?50

------------------
Ciao,
Marc

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