Does anyone have a LISP to copy the angle of a line and paste it to selected text?

Hi I am trying to find a LISP to copy the angle of a selected line, in this case in degrees minutes and seconds(53°00'40") and transfer it to an already existing piece of text that sits on the line. A variation could be to insert a new piece of text but it would have to be inserted at the copied angle. I would appreciate anyone who can solve this for me.

You could use my Quick Field utility to achieve this, by referencing the Angle property of a Line object.

Read the instructions included on the program page to understand how to configure the program for your task.

Hi Lee,

Thank you for coming back to me so quickly. I will have a play with your quickfield lisp. even though i have little (no real) experience with programming. My first thought would be, I need the text to read the degree symbol and not "d". for example it needs to be 53°00'40" not 53d00'40". I'm might be wrong but I don't think a field will allow me to do a find and replace or edit the text to that level of detail.

Thanks again for the reply.

Lee,

This is a really cool lisp routine! I have created a new test4 and fumbled around the field dialog box to get the variables. (defun c:test4 ( ) (LM:QuickField "Angle" "%au1%pr3%" 3))

It worked a treat. I just donated to the cause. I can explode the field and do the required find and replace to keep the client happy so no worries there. Just one more thing, If i wanted to insert the field (text) at the same angle as the line, what code and where would i need to insert it? Thanks again.

Firstly, thank you for your contribution supercell - I really appreciate your gratitude & respect for my time, and I'm delighted that you find my Quick Field program useful. It's also encouraging that you were able to construct your own custom program 'test4' based on my instructions & examples with little to no prior programming experience.

Though, as you have noted, since you require the degree symbol to be used in place of the 'd' for the degree measurement, a field expression may not be the most suitable solution - instead, please try the following code:

([color=BLUE]defun[/color] c:lang ( [color=BLUE]/[/color] ang ent ins pnt ocs )
   ([color=BLUE]while[/color]
       ([color=BLUE]progn[/color] ([color=BLUE]setvar[/color] 'errno 0) ([color=BLUE]setq[/color] ent ([color=BLUE]entsel[/color]))
           ([color=BLUE]cond[/color]
               (   ([color=BLUE]=[/color] 7 ([color=BLUE]getvar[/color] 'errno))
                   ([color=BLUE]princ[/color] [color=MAROON]"\nMissed, try again."[/color])
               )
               (   ([color=BLUE]null[/color] ent)
                   [color=BLUE]nil[/color]
               )
               (   ([color=BLUE]vl-catch-all-error-p[/color]
                       ([color=BLUE]setq[/color] pnt
                           ([color=BLUE]vl-catch-all-apply[/color] '[color=BLUE]vlax-curve-getclosestpointto[/color]
                               ([color=BLUE]list[/color] ([color=BLUE]car[/color] ent) ([color=BLUE]trans[/color] ([color=BLUE]cadr[/color] ent) 1 0))
                           )
                       )
                   )
                   ([color=BLUE]princ[/color] [color=MAROON]"\nInvalid object selected."[/color])
               )
               (   ([color=BLUE]setq[/color] ins ([color=BLUE]getpoint[/color] [color=MAROON]"\nSpecify point for text: "[/color]))
                   ([color=BLUE]setq[/color] ocs ([color=BLUE]trans[/color] '(0.0 0.0 1.0) 1 0 [color=BLUE]t[/color])
                         ang ([color=BLUE]angle[/color] '(0.0 0.0) ([color=BLUE]trans[/color] ([color=BLUE]vlax-curve-getfirstderiv[/color] ([color=BLUE]car[/color] ent) ([color=BLUE]vlax-curve-getparamatpoint[/color] ([color=BLUE]car[/color] ent) pnt)) 0 ocs [color=BLUE]t[/color]))
                   )
                   ([color=BLUE]entmake[/color]
                       ([color=BLUE]list[/color]
                          '(000 . [color=MAROON]"TEXT"[/color])
                          '(072 . 1)
                          '(073 . 2)
                           ([color=BLUE]cons[/color] 010 ([color=BLUE]trans[/color] ins 1 ocs))
                           ([color=BLUE]cons[/color] 011 ([color=BLUE]trans[/color] ins 1 ocs))
                           ([color=BLUE]cons[/color] 040 ([color=BLUE]getvar[/color] 'textsize))
                           ([color=BLUE]cons[/color] 007 ([color=BLUE]getvar[/color] 'textstyle))
                           ([color=BLUE]cons[/color] 001 ([color=BLUE]vl-string-translate[/color] [color=MAROON]"d"[/color] ([color=BLUE]chr[/color] 176) ([color=BLUE]angtos[/color] ang 1 3)))
                           ([color=BLUE]cons[/color] 050 ang)
                           ([color=BLUE]cons[/color] 210 ocs)
                       )
                   )
               )
           )
       )
   )
   ([color=BLUE]princ[/color])
)

The above is compatible with any geometric object (line, polyline, arc, circle, ellipse, spline, xline) and should perform successfully with objects constructed in any UCS.

Lee, this is awesome! It works perfectly. Thanks again for all of your efforts.

Thanks! - You're most welcome supercell.

supercell said:

...for example it needs to be 53°00'40" not 53d00'40"....

FWIW...

normal format 53d0'40"

--> 53°00'40"

;;;Example:

;;;(setq ang (angtof "123d4'5\""))
;;;(angtos ang 1 4)
;;;"123d4'5\"" <--- normal format
;;;(_dmmss ang )
;;;"123°04'05\""


(defun _dmmss (ang  / $ str l); angle in radian
;;;hanhphuc
 (setq	$ (angtos ang 1 4)
        l (mapcar ''((x) (vl-string-search x $)) '("\"" "'" "d")))
 (vl-string-subst "°" ;(chr 176)
                  "d" 
;;;This method maybe slower than normal cond , just for fun :-)
    (cadr (eval (cons 'cond
         (mapcar '(lambda (i j)(cons (equal (list (- (car l) (cadr l)) (apply '- (cdr l))) i)
 	           (mapcar 'cons '(setq mapcar)
		      (list '(str $) (cons ' ' ' ((a b) (setq str (vl-string-subst (strcat a b) a str)))
			(mapcar 'cons '(list list) (list '("'" "d") j)))))))
		'((2 2) (3 2) (2 3) (3 3))'(("0" "0") ("" "0") ("0" "") ("" ""))
	)
     )
  )
      )
   )
)

here's a simple reactor approach, still need some mod

(defun c:linear (/ ss e i )
;;hanhphuc 13.01.2016
 (if (setq ss (ssget "_:L" '((0 . "LINE"))))
   (repeat (setq i (sslength ss))
     (progn (setq *line-noti-angdist-obj* (vlax-ename->vla-object (ssname ss (setq i (1- i)))))
            (if (or (not *vor-line-angdist*) (zerop (length (vlr-owners *vor-line-angdist*))))
              (setq *vor-line-angdist*
                     (vlr-object-reactor 
                       (list *line-noti-angdist-obj*) ;owner
                       "Linear Reactor" ;data
                       '((:vlr-modified . angdist_label)) ;callbacks
                       ) 
                    ) 
              (if (vl-position *line-noti-angdist-obj* (vlr-owners *vor-line-angdist*))
                (princ (strcat "\n" (vlr-data *vor-line-angdist*) " exists!"))
                (vlr-owner-add *vor-line-angdist* *line-noti-angdist-obj*)
                )
              )
            )
     
   (if *line-noti-angdist-obj*
     (vla-put-color *line-noti-angdist-obj* AcBylayer)
     )
   )
 )
(princ)
)


(defun angdist_label (vo reac args / pts ad)
 (if (vlax-erased-p vo)
   (princ "\nReferenced object erased!")
   (progn (setq pts (mapcar ''((x / p) (setq p (vlax-get vo x)) (list (car p) (cadr p)))
                            '(StartPoint EndPoint)
                            )
                ad  (mapcar ''((x) (apply x (mapcar ''((x) (trans x 0 1)) pts))) '(angle distance))
                )
          (entmakex (mapcar 'cons
                            '(0 100 100 1 10 40 50 8 71 72)
                            (list "MTEXT" "AcDbEntity" "AcDbMText"
                                  (strcat (_dmmss (car ad)) "\\P" (rtos (cadr ad) 2 3))
                                  (apply 'mapcar (cons ''((a b) (* (+ a b) 0.5)) pts))
                                  (/ (cadr ad) 50.)
                                  (MakeReadable (car ad))
                                  "ANG&DIST LABEL"
                                  5 5
                                  )
                            )
                    )
          )
   )
 (princ)
 )

(vl-load-com)
(defun MakeReadable (a) ;; ymg
 (setq a (rem (+ a pi pi) (+ pi pi)))
 (rem (if (< (* pi 0.5) a (* pi 1.5))
        (+ a pi)
        a
        )
      (+ pi pi)
      )
 )