Turning text to align to a line, great tool for drafting

[allanthebruce]

HI There, 

I have this great little lisp that helps to rotate and align text to a line, great for drafting. How can I alter this so when i select the text in the window it will ignore anything but Mtext or Text, currently it will move rotate, align everythig i select in the window.

Or better still create a new lisp refined....

Much appreciate any help.

Cheers

Allan

(PROMPT "\nLOADING FILE .........")
;
; CHANGE THE ROTATION OF SELECTED TEXT

(defun C:TT ( / selset newscl l n e as)
(setq olderr *error* *error* err)

(setq selset (ssget))

(command "undo" "begin")
(GETSYS)
;;LCA - COMMENT: The UCS command has new options.
(COMMAND "UCS" "W")

(setq
newrot (getorient "\nNew Orientation, Pick 2 points (Return to leave same): ")
newscl (getreal "\nNew Height (Return to leave same): ")
)
(if selset
(progn
(setq l 0 n (sslength selset))
(while (< l n)
(if (wcmatch (cdr (assoc 0 (setq e (entget (ssname selset l))))) "*TEXT")
(progn
(prompt ".")
(if newscl
(progn
(setq s (cdr (setq as (assoc 40 e))))
(setq e (subst (cons 40 newscl) as e))
(entmod e)
)
)
(if newrot
(progn
(setq s (cdr (setq as (assoc 50 e)))
; cur (getvar "UCSNAME")
; n (cdr (assoc 12 (tblsearch "UCS" cur)))
; m (cdr (assoc 10 (tblsearch "UCS" cur)))
; ax (- (cadr n) (cadr m) ) bx (- (car n) (car m) )
; alpha (atan ax bx)
)
(setq e (subst (cons 50 newrot) as e))
(entmod e)
)
)
)
)
(setq l (1+ l))
)
)
)
;;LCA - COMMENT: The UCS command has new options.
(command "ucs" "p")
(command "osnap" "none")
(command "move" "P" "" pause pause)
(resetsys)
(command "undo" "end")
(princ)
)

[pendean]

Like this perhaps http://www.lee-mac.com/curvealignedtext.html
Scroll down and watch the demonstration on that page, it works with lines too.

[paullimapa]

Looks like this line in the code is placed there so that the operation should only apply to *TEXT:

(if (wcmatch (cdr (assoc 0 (setq e (entget (ssname selset l))))) "*TEXT")

But if you want at the time of selection to only allow for *TEXT then change this line towards the beginning of code:

(setq selset (ssget))

to this:

(setq selset (ssget '((0 . "*TEXT"))))

[allanthebruce]

Thanks alot for this it has been excellent a real time saver. One thing I ask is there something in this lisp that's making it autosave tmp file almost every time I use it, it pauses saves tmp then ok to resume, i haven't noticed till now and quite annoying. appreciate any InSite.

Thanks

Allan

[john.kaulB9QW2]

This thread should receive a nomination to the "how not to do it" awards.

- A user asked a question(s) about a lisp.
- A user ignores the question(s) and posts a link to a readymade solution instead.
- A user posts a solution to original users' question(s) which is ignored (because now the OP has new/different issues/questions).

*face-palm*
A great thread--example--in a "development/customization forum".

[john.kaulB9QW2]

*like*
This post deserves a "like" because it offers help to the OP.

[john.kaulB9QW2]

*dislike*
Scroll up to (re)read the OP's question.

[Kent1Cooper]

---

@allanthebruce wrote:

.... is there something in this lisp that's making it autosave tmp file almost every time I use it....

---

My guess:  That is done by something in the  (resetsys)  function, for which you don't include the code, so we can't tell.

[calderg1000]

Regards @allanthebruce 

Try this modified code, add the option to align the text to an existing line...

(PROMPT "\nLOADING FILE .........")
;
; CHANGE THE ROTATION OF SELECTED TEXT
(defun C:TT1 (/ selset es opc newrot newscl sl sp ep l n s e as)
  (setq olderr  *error*
        *error* err
  )
  (princ "\nSelect TEXT/MTEXT")
  (while
    (setq selset (ssget "+.:E:S" '((0 . "*TEXT")))
          es     (entget (ssname selset 0))
          sp     (cdr (assoc 10 es))
    )
     (command "undo" "begin")
     ;;LCA - COMMENT: The UCS command has new options.
     (command "UCS" "W")
     (initget 1 "P S")
     (setq
       opc (getkword "Select Orientation 2 Points/Selection Line [P/S] <P>:")
     )
     (if (= opc "P")
       (setq
         newrot (getorient sp)
         newscl (getreal "\nNew Height (Return to leave same): ")
       )
     )
     (if (= opc "S")
       (setq
         sl     (entget (car (entsel "\nSelect Line:")))
         Sp     (cdr (assoc 10 sl))
         Ep     (cdr (assoc 11 sl))
         newrot (angle Sp Ep)
         newscl (getreal "\nNew Height (Return to leave same): ")
       )
     )
     (if selset
       (progn
         (setq l 0
               n (sslength selset)
         )
         (while (< l n)
           (setq e (entget (ssname selset l)))
           (if newscl
             (progn
               (setq s (cdr (setq as (assoc 40 e)))
                     e (subst (cons 40 newscl) as e)
               )
               (entmod e)
             )
           )
           (if newrot
             (progn
               (setq s (cdr (setq as (assoc 50 e)))
                     e (subst (cons 50 newrot) as e)
               )
               (entmod e)
             )
           )
           (setq l (1+ l))
         )
       )
     )
     ;;LCA - COMMENT: The UCS command has new options.
     (command "ucs" "p")
     (command "move" "P" "" "_none" (cdr (assoc 10 e)) pause)
     (command "undo" "end")
     (princ)
  )
)