Schlagwort: AutoLips

;*
;* ATEXT types text in an arc. The function gets the midpoint of the
;* txt, the radius point, and the orientation. It determines if the text
;* height is fixed and prompts for height if not. It uses the ANGTOC function.#
;* MCD Media consulting -Helge Brettschneider


; changed radi (distance radp midp) to radi (hd radp midp)  WRM 7/31/89

(defun C:ARTEXT ( / midp radp txt radi txtlen txtspc txthgt cmd arclen
  arcang sang orent txtang txtp char)

  (setvar "HIGHLIGHT" 0)        ;Schaltet highlite aus
  (setvar "CMDECHO" 0)          ;Schaltet die Meldungen in der Befehlszeile aus
(SETQ ABASE(GETVAR"ANGBASE"))   ;Aktuelle Einstellungen werden gespeichert und später wieder aktiviert
(SETVAR"ANGBASE" 0)             ;Ausgangswinkel wird angepasst
  (setq                         ;Variablen werden festgelegt
    radp (getpoint "\nZentrum des Kreis angeben: " )        ;Zentrum des Kreisbogens wird festgelegt
    midp (getpoint "\nTextposition: " radp) ;Mittelpunkt des Text wird festgelegt
    txt (getstring "\nText: " T)                    ;Text eingeben
    radi (hd radp midp)                       ;Radius ermitteln
    txtlen (strlen txt)                             ;Textleänge ermitteln
    txtspc (cdr (assoc 41 (tblsearch "STYLE" (getvar "TEXTSTYLE"))))  ;Aktuellen Textstil ermitteln
  );Ende der Variablenzuweisung

  (if (= (setq txthgt (cdr (assoc 40 (tblsearch "STYLE" (getvar "TEXTSTYLE"))))) 0)
       ;Test ob eine feste Höhe existiert
    (setq                       ;Wenn nicht dann...  
      txthgt (getdist "\nTexthoehe: ")  ;Texthöhe abfragen
      cmd '(command "_TEXT" "_C" txtp txthgt txtang char) ;Befehlsliste
    )
    (setq                       ;Wenn eine feste höhe existiert...
      cmd '(command "_TEXT" "_C" txtp txtang char)    ;Befehlsliste
    )
  );end if

  (setq orent         ;Textausrichtung
    (strcase (getstring "\nZeigt Die Hoehe in Richtung des Zentrums; <J>: ")) ;ueber
  )

  (if (or (= orent "") (= orent "J"))   ;Radiuslänge und Ausrichtung
    (setq radi (- radi (/ txthgt 2)))
    (setq radi (+ radi (/ txthgt 2)))          
  );end if

  (setq               ;Berechnungen
    arclen (* txtlen txtspc txthgt)       ;Berechnung der Länge des Bogens
    txtspc (/ arclen txtlen)              ;Berechnung der Länge eines Buchstabens
    arcang (/ arclen radi)                ;Berechnung des Winkels eines Buchstabens
    sang (- (+ (angle radp midp) (/ arcang 2)) (/ txtspc radi 2))  ;Berechung des Startwinkel
    count 1           ;Counter        
  )

  (repeat txtlen      ;Buchstaben einfügen schleife
    (if (or (= orent "") (= orent "Y"))   ;Test winkel
        (setq txtang (angtoc  ;Preface angle w/ << for universal angular units in dec. string
                       (- sang (/ pi 2))  ;Convert start angle minus 90deg
                     )                                      
              txtpos count
        )
        ;Calc angle for character towards radius and character position in string
        (setq txtang (angtos (- sang (* pi 1.5)) 0) ;angle to a command function
           txtpos (- (1+ txtlen) count)
        )
        ;Calc angle for character away from radius and character position in string
    )
    (setq txtp (polar radp sang radi))    ;Calculate character point
    (setq char (substr txt txtpos 1))     ;Get text character
    (eval cmd)                            ;Execute command list
    (setq count (1+ count))               ;Increment counter
    (setq sang (- sang (/ txtspc radi)))  ;Calculate new start angle
  );End repeat loop

  (setvar "HIGHLIGHT" 1)        ;Turn highlight on
  (setvar "CMDECHO" 1)          ;Turn command echo on
  (SETVAR"ANGBASE" ABASE)       ;restore angle base direction
  (princ)                       ;Ends program cleanly
);End defun
;* ANGTOC is a angle formatting function that takes an angle
:* argument in radians and returns it with 6 decimal places
;* in a form universally acceptable to AutoCAD command input.

(defun angtoc (ang)
  (setq ang
    (rtos (atof (angtos ang 0 8)) 2 6)
  )
  (strcat "<<" ang)
)

; return horizontal distance
(defun hd (p1 p2)
   (distance (list (car p1) (cadr p1)) (list (car p2) (cadr p2)))
)
(princ)