Author Topic: Line / text match  (Read 2381 times)

0 Members and 1 Guest are viewing this topic.

One Shot

  • Guest
Line / text match
« on: November 01, 2004, 04:39:17 PM »
There have been several times that I had the ability to match angles of lines and text to each other. I hate doing a property of a line or text to get the rotation and then copy and paste to make them match.

Here is an example: You have a line that is at an angle of 40 degrees. There is text above it that does not match the angle. So the only way to match the angle of the line and / or text is by check the properties or doing a list. So you copy the angle of the line and then paste it to the text properties. Now you have done 3 steps to get the correct angle of text.

I know about Torient.  But is routine out there that can be used with a button?

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Line / text match
« Reply #1 on: November 01, 2004, 04:50:35 PM »
Here is one I had in my 'Borrowed Code' folder
Code: [Select]
;;; rt.LSP Version 3.0 - 01 MAR 1998
;;;
;;; Copyright 1998 by R.K. McSwain
;;; Additional functionality added by A. Henderson ©2002              

;;; Permission to use, copy, modify, and distribute this software for
;;; any purpose and without fee is hereby granted, provided that the
;;; above copyright notice appears in all copies and that both the    
;;; copyright notice and the limited warranty and restricted rights  
;;;  notice below appear in all supporting documentation.            
;;;
;;; R.K. McSwain provides this program "AS IS" and with all faults.  
;;; R.K. McSwain specifically disclaims any implied warranty of      
;;; merchantability or fitness for a particular use. autodesk, inc.  
;;; does not warrant that the operation of the program will be        
;;; uninterrupted or error free.                                      

;;; This program will match text angle to a line angle selected      

;;; Added July 2002
;;; Option to move Text from original position to the selected point
;;; on the line
;;; Works with Dtext left justified                                  

;;;--------------------------------------------------------------------
(defun c:MRT (/   ANG ANG1 ANG2 BOB COSROT ENTTYP   ENTTYP2   GETIT L1 NANG OANG
               OANGPRT OLDORTHO OLDOSMODE P0 P1 P2 PT1 SINROT SL ST   T1 TEXTOBJX
               TIME TIME2 TX1 WAIT   WAIT2 WHY X1 X2   MoveIt)

;;; first get your settings !
     (setq oldortho  (getvar "orthomode")
      oldosmode (getvar "osmode")
     ) ;_ end of setq
;;; then turn everything off
     (setvar "orthomode" 0)
     (setvar "osmode" 0)
     (setvar "cmdecho" 1)

;;;finds the angle of the line
     (setq wait "T")
     (while wait
     (setq time "T")
     (while time
          (setq sl (entsel "\n Pick Angle To Match:"))
          (setq Pt1 (osnap (cadr sl) "nea")) ; get "nearest" point on line picked
          (if (/= sl nil)
          (setq time nil)
          ) ;_ end of if
     ) ;_ end of while
     (setq   l1     (entget (car sl))
      enttyp (cdr (assoc 0 l1))
     ) ;_ end of setq
     (if (= enttyp "LINE")
          (setq wait nil)
     ) ;_ end of if
     ) ;_ end of while
     (setq p1 (cdr (assoc 10 l1))
      x1 (car p1)
      p2 (cdr (assoc 11 l1))
      x2 (car p2)
     ) ;_ end of setq

     (setq why (angle p1 p2))
     (if (>= why 0)
     (setq ang1 why)
     ) ;_ end of if
     (if (> why 1.5708)         ;same as 90°
     (setq ang1 (+ 3.14159 why))   ;add 180°
     ) ;_ end of if
     (if (>= why 4.71413)      ;same as 270.1°
     (setq ang1 why)
     ) ;_ end of if

;;;finds angle of txt
     (setq wait2 "T")
     (while wait2
     (setq time2 "T")
     (while time2
          (setq st (entsel "\n Pick Text To Change:"))
          (if (/= st nil)
          (setq time2 nil)
          ) ;_ end of if
     ) ;_ end of while
     (setq   tx1   (entget (car st))
      enttyp2   (cdr (assoc 0 tx1))
     ) ;_ end of setq
     (if (= enttyp2 "TEXT")
          (setq wait2 nil)
     ) ;_ end of if
     ) ;_ end of while
     (setq ang2   (cdr (assoc 50 tx1))
      oang   (cons 50 ang2)
      nang   (cons 50 ang1)
      tx1   (subst nang oang tx1)
     ) ;_ end of setq
     (entmod tx1)
     (terpri)
     (setq bob "T")
     (while bob
     (initget 6 "M m")
     (setq getit (getkword "\n Press M to rotate 180° or <ENTER> to quit "))
     (if (or (= getit "m") (= getit "M"))
          (progn
          (setq oang     (assoc 50 tx1)
           oangprt (cdr oang)
           nang     (cons 50 (+ 3.14159 oangprt))
           tx1     (subst nang oang tx1)
          ) ;_ end of setq
          (entmod tx1)
          ) ;_ end of progn
          (setq bob nil)
     ) ;_ end of if
     ) ;_ end of while

;;;********** Finds the "textbox" boundary of the new text position
;;;********** & sets "move" position to lower left corner

     (setq TextobjX st)
     (setq p0     (cdr (assoc 10 tx1))
      ang     (cdr (assoc 50 tx1))
      sinrot (sin ang)
      cosrot (cos ang)
      t1     (car (textbox tx1))
      p1     (list
             (+ (car p0)
           (- (* (car t1) cosrot) (* (cadr t1) sinrot))
             ) ;_ end of +
             (+ (cadr p0)
           (+ (* (car t1) sinrot) (* (cadr t1) cosrot))
             ) ;_ end of +
        ) ;_ end of list
     ) ;_ end of setq
     
;;;********** Do you want to move it or not ?

     (initget "Y N")
     (setq MoveIt (getkword "\Do you wish to move the selected text [Yes/No] <Y> ?"))
     (if (= MoveIt "N")
     (command)
     (command "move" st "" p1 pt1)
     ) ;_ end of if

;;;**********
;;; & then restore them !
     (setvar "cmdecho" 0)
     (setvar "orthomode" Oldortho)
     (setvar "osmode" oldosmode)
     (princ)
) ;_ end of defun
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

One Shot

  • Guest
Line / text match
« Reply #2 on: November 01, 2004, 05:10:13 PM »
Quote from: CAB
Here is one I had in my 'Borrowed Code' folder
Code: [Select]
;;; rt.LSP Version 3.0 - 01 MAR 1998
;;;
;;; Copyright 1998 by R.K. McSwain
;;; Additional functionality added by A. Henderson ©2002              

;;; Permission to use, copy, modify, and distribute this software for
;;; any purpose and without fee is hereby granted, provided that the
;;; above copyright notice appears in all copies and that both the    
;;; copyright notice and the limited warranty and restricted rights  
;;;  notice below appear in all supporting documentation.            
;;;
;;; R.K. McSwain provides this program "AS IS" and with all faults.  
;;; R.K. McSwain specifically disclaims any implied warranty of      
;;; merchantability or fitness for a particular use. autodesk, inc.  
;;; does not warrant that the operation of the program will be        
;;; uninterrupted or error free.                                      

;;; This program will match text angle to a line angle selected      

;;; Added July 2002
;;; Option to move Text from original position to the selected point
;;; on the line
;;; Works with Dtext left justified                                  

;;;--------------------------------------------------------------------
(defun c:MRT (/   ANG ANG1 ANG2 BOB COSROT ENTTYP   ENTTYP2   GETIT L1 NANG OANG
               OANGPRT OLDORTHO OLDOSMODE P0 P1 P2 PT1 SINROT SL ST   T1 TEXTOBJX
               TIME TIME2 TX1 WAIT   WAIT2 WHY X1 X2   MoveIt)

;;; first get your settings !
     (setq oldortho  (getvar "orthomode")
      oldosmode (getvar "osmode")
     ) ;_ end of setq
;;; then turn everything off
     (setvar "orthomode" 0)
     (setvar "osmode" 0)
     (setvar "cmdecho" 1)

;;;finds the angle of the line
     (setq wait "T")
     (while wait
     (setq time "T")
     (while time
          (setq sl (entsel "\n Pick Angle To Match:"))
          (setq Pt1 (osnap (cadr sl) "nea")) ; get "nearest" point on line picked
          (if (/= sl nil)
          (setq time nil)
          ) ;_ end of if
     ) ;_ end of while
     (setq   l1     (entget (car sl))
      enttyp (cdr (assoc 0 l1))
     ) ;_ end of setq
     (if (= enttyp "LINE")
          (setq wait nil)
     ) ;_ end of if
     ) ;_ end of while
     (setq p1 (cdr (assoc 10 l1))
      x1 (car p1)
      p2 (cdr (assoc 11 l1))
      x2 (car p2)
     ) ;_ end of setq

     (setq why (angle p1 p2))
     (if (>= why 0)
     (setq ang1 why)
     ) ;_ end of if
     (if (> why 1.5708)         ;same as 90°
     (setq ang1 (+ 3.14159 why))   ;add 180°
     ) ;_ end of if
     (if (>= why 4.71413)      ;same as 270.1°
     (setq ang1 why)
     ) ;_ end of if

;;;finds angle of txt
     (setq wait2 "T")
     (while wait2
     (setq time2 "T")
     (while time2
          (setq st (entsel "\n Pick Text To Change:"))
          (if (/= st nil)
          (setq time2 nil)
          ) ;_ end of if
     ) ;_ end of while
     (setq   tx1   (entget (car st))
      enttyp2   (cdr (assoc 0 tx1))
     ) ;_ end of setq
     (if (= enttyp2 "TEXT")
          (setq wait2 nil)
     ) ;_ end of if
     ) ;_ end of while
     (setq ang2   (cdr (assoc 50 tx1))
      oang   (cons 50 ang2)
      nang   (cons 50 ang1)
      tx1   (subst nang oang tx1)
     ) ;_ end of setq
     (entmod tx1)
     (terpri)
     (setq bob "T")
     (while bob
     (initget 6 "M m")
     (setq getit (getkword "\n Press M to rotate 180° or <ENTER> to quit "))
     (if (or (= getit "m") (= getit "M"))
          (progn
          (setq oang     (assoc 50 tx1)
           oangprt (cdr oang)
           nang     (cons 50 (+ 3.14159 oangprt))
           tx1     (subst nang oang tx1)
          ) ;_ end of setq
          (entmod tx1)
          ) ;_ end of progn
          (setq bob nil)
     ) ;_ end of if
     ) ;_ end of while

;;;********** Finds the "textbox" boundary of the new text position
;;;********** & sets "move" position to lower left corner

     (setq TextobjX st)
     (setq p0     (cdr (assoc 10 tx1))
      ang     (cdr (assoc 50 tx1))
      sinrot (sin ang)
      cosrot (cos ang)
      t1     (car (textbox tx1))
      p1     (list
             (+ (car p0)
           (- (* (car t1) cosrot) (* (cadr t1) sinrot))
             ) ;_ end of +
             (+ (cadr p0)
           (+ (* (car t1) sinrot) (* (cadr t1) cosrot))
             ) ;_ end of +
        ) ;_ end of list
     ) ;_ end of setq
     
;;;********** Do you want to move it or not ?

     (initget "Y N")
     (setq MoveIt (getkword "\Do you wish to move the selected text [Yes/No] <Y> ?"))
     (if (= MoveIt "N")
     (command)
     (command "move" st "" p1 pt1)
     ) ;_ end of if

;;;**********
;;; & then restore them !
     (setvar "cmdecho" 0)
     (setvar "orthomode" Oldortho)
     (setvar "osmode" oldosmode)
     (princ)
) ;_ end of defun


Cab,


I want to modify this part of the routine to 1.5 of the width of the text away from the line.  Am I looking in the right place.  If so, how would I look at doing that.  I have txtstack.lisp here that I want to use for an example.

(initget "Y N")
     (setq MoveIt (getkword "\Do you wish to move the selected text [Yes/No] <Y> ?"))
     (if (= MoveIt "N")
     (command)
     (command "move" st "" p1 pt1)
     ) ;_ end of if

;;;**********
;;; & then restore them !
     (setvar "cmdecho" 0)
     (setvar "orthomode" Oldortho)
     (setvar "osmode" oldosmode)
     (princ)
) ;_ end of defun