Visual LISP, AutoLISP and General Customization
cancel
Showing results for 
Show  only  | Search instead for 
Did you mean: 

Need LISP to draw line / pline to match TEXT rotation!

14 REPLIES 14
Reply
Message 1 of 15
econnerly
1925 Views, 14 Replies

Need LISP to draw line / pline to match TEXT rotation!

I have searched everywhere but have found nothing. There are a ton of lisp to match text rotation to a selected line, but not vice versa.

Anyone out there have anything?

Tags (1)
14 REPLIES 14
Message 2 of 15
Anonymous
in reply to: econnerly

Set your ucs to object and select the text object.  Make sure your ortho is on and draw your line or pline to the length desired.

Message 3 of 15
econnerly
in reply to: Anonymous

Nice! Thanks.
Im sure that should be easy to write a lisp routine that would set the usc for while drawing the line and then set the ucs back to "previous" when the command is over.

Message 4 of 15
stevor
in reply to: econnerly

Try:

 

 ; DXF data value from code number
 (defun DXF_ (n aLst) (cdr (assoc n aLst)) )
 
 ; Text Line
 (defun C:txl (/  dl en es ps pe p1 p2 tbx clns nlns dyr )
   (setvar "cmdecho" 0) (terpri) (grtext -1 " AusCadd.com  ")
   (setq Clns (getvar "clayer")  nlns "Text-Line")
   (princ"\n Set Layer to: ") (prin1 lyns)
   (if (not (equal (strcase (getvar "clayer")) (strcase nlns)))
     (command "-layer" "make" nlns  "") ) :
   ;
   (if (and (setq es (ent_seld  es "\n  Sel  Text  Ent: "))
            (setq en (car es)  dl (entget en))
            (= "TEXT" (DXF_ 0 DL)) )
    (PROGN (redraw)  ; expert >3
     (command "UCS" "save" "temp" "ucs" "ob" en )
     (princ " UCS saved to Temp, set to Object  ")
     (setq tbx (textbox dL)  p1 (car tbx)  p2 (cadr tbx)
           dyr 3 ; can be entered each time, or upon file load, etc
           ps (list (car p1) (- (/ tH dyr)) 0)   ; left
           pe (list (car p2) (- (/ tH dyr)) 0) ) ; right
     ;
     (command "Line" "none" ps "none" pe "") ; "0" or 0 ?
     (command "UCS" "res" "temp"   ) ; restore UCS
     (setvar "clayer" clns)  ;   Layer
     ;
    ) (princ" Nyet ") )  ;  pr
  (princ)
 ) ;  def

S
Message 5 of 15
pbejse
in reply to: econnerly


@econnerly wrote:

I have searched everywhere but have found nothing. There are a ton of lisp to match text rotation to a selected line, but not vice versa.

Anyone out there have anything?


One thing comes to mind

 

POLAR TRACKING:

 

(defun c:test ()
  	(setvar 'polarmode 4)
  	(setq Txt (car (entsel "\nSelect Text/Mtext: :")))
  	(wcmatch (cdr (assoc 0 (setq txt (entget txt)))) "*TEXT")
  	(setvar 'polarang (cdr (assoc 50 txt)))
  	(command "_line"))
)

 

Message 6 of 15
stevor
in reply to: econnerly

If you try mine, C:TXL, the lie:

 

(if (and (setq es (ent_seld  es "\n  Sel  Text  Ent: "))

 

needs to be replaced by:

 

(if (and (setq es (entsel  "\n  Sel  Text  Ent: "))

 

because Ent_SelD is a local subroutine to include a default selection,  accidentally left in, and not appropriate for this. [sorry ]

S
Message 7 of 15
stevor
in reply to: econnerly

Again, if you use c:TXL the following additions:

 

add the line

           TH (dxf_ 40 dl)
after 

     (setq tbx (textbox dL)  p1 (car tbx)  p2 (cadr tbx)
because: unknown.

 

Also, Expert must be set to 4 or more, which it usally is, but a test and reset could have been added, yet was not.

 

 

S
Message 8 of 15
Kent1Cooper
in reply to: econnerly


@econnerly wrote:

....
Im sure that should be easy to write a lisp routine that would set the usc for while drawing the line and then set the ucs back to "previous" when the command is over.


Or, you can change the SNAPANG System Variable to match the Text, rather than the UCS.  If you want a single Line segment, in simplest terms:
 

(defun C:TAL (/ sang orth txt); = Text-Aligned Line
  (setq
    sang (getvar 'snapang)
    orth (getvar 'orthomode)
    txt (entget (car (entsel "\nSelect Text to Align Line with: ")))
  ); setq
  (setvar 'snapang (cdr (assoc 50 txt)))
  (setvar 'orthomode 1)
  (command "_.line" pause pause "")
  (setvar 'snapang sang)
  (setvar 'orthomode orth)
)

 

If you want to be able to draw multiple sequential Line segments, or a Polyline:

 

....

  (setvar 'orthomode 1)
  (command "_.line"); or "_.pline"

  (while (> (getvar 'cmdactive) 0) (command pause))
  (setvar 'snapang sang)

....

 

Either works with Mtext as well as Text.  Add error handling, selected-object-type control, switching to Text's Layer, etc., as desired.

Kent Cooper, AIA
Message 9 of 15
econnerly
in reply to: econnerly

You guys rock! Thanks very much. Both routines produce the result that I was looking for!

Message 10 of 15
Kent1Cooper
in reply to: stevor


@stevor wrote:

....

     (command "UCS" "save" "temp" "ucs" "ob" en )
     (princ " UCS saved to Temp, set to Object  ")
....

     (command "UCS" "res" "temp"   ) ; restore UCS
....


You could avoid the need to save a temporary UCS [which you probably should also delete after you're done with it], by just using the Previous option to put it back where it was:

 

....

     (command "UCS" "ob" en)
....

     (command "UCS" "_previous") ; restore UCS
....

 

If you were doing multiple operations that might involve changing the UCS more than once in the process, then I could see more value in saving a temporary UCS to restore later.

Kent Cooper, AIA
Message 11 of 15
stevor
in reply to: Kent1Cooper

Saving UCS as Temp, in reply to Kent, etal:  Yep, and your "P" for Previous is the better way, for that case, and for most cases.

 

Save the UCS is a debug habit, not normally required.

S
Message 12 of 15
alanjt_
in reply to: stevor

Just account for the UCS being something other than world...

 

(defun c:Test (/ e d p)
  (vl-load-com)
  (setvar 'ERRNO 0)
  (if
    (and
      (progn
        (while (progn (setq e (car (entsel "\nSelect *Text object for angle: ")))
                      (cond ((eq (getvar 'ERRNO) 7) (princ "\nMissed, try again."))
                            ((eq (type e) 'ENAME)
                             (if (not (wcmatch (cdr (assoc 0 (setq d (entget e)))) "MTEXT,TEXT"))
                               (princ "\nInvalid object!")
                             )
                            )
                      )
               )
        )
        e
      )
      (setq p (getpoint "\nSpecify first point: "))
    )
     (progn
       (vl-cmdf
         "_.line"
         "_non"
         p
         (strcat
           "<"
           (angtos (if (and (eq (cdr (assoc 0 d)) "TEXT") (zerop (getvar 'WORLDUCS)))
                     (- (cdr (assoc 50 d))
                        (angle '(0. 0. 0.) (trans (getvar 'UCSXDIR) 0 (trans '(0. 0. 1.) 1 0 T) T))
                     )
                     (cdr (assoc 50 d))
                   )
                   (getvar 'AUNITS)
                   4
           )
         )
         PAUSE
       )
       (while (eq (logand 1 (getvar 'CMDACTIVE)) 1) (vl-cmdf ""))
     )
  )
  (princ)
)

 

Message 13 of 15
econnerly
in reply to: stevor

PERFECT! Thank you very very much!

Message 14 of 15
stevor
in reply to: econnerly

To Econnerly;

 

1. Notice the post of alanjt: I do not recall if my post included UCS translations.

 

2. And notice that you can change the Layer and LINE offset down distance, in the code.

 

And remove the temp UCS, as per Kent1's post.

 

 

S
Message 15 of 15
scot-65
in reply to: econnerly

I was actually thinking of another alternative that goes something like this:

 

(setq p1 (cdr (assoc 10 (setq b (entget (car (entsel)))))))

(command ".xline" p1 (polar p1 (cdr (assoc 50 b)) 1) "")

 

Yes, it's tested!

 

🙂


Scot-65
A gift of extraordinary Common Sense does not require an Acronym Suffix to be added to my given name.


Can't find what you're looking for? Ask the community or share your knowledge.

Post to forums  

Autodesk Design & Make Report

”Boost