Lisp routine to measure line and add length to existing text

Hi all, I'm new to this forum and know very little about programming lisp routines. I usually just come across ones every now and then and add them to my installation of AutoCAD.

I was looking for a Lisp routine that would be able to measure a 2d line of my choosing, then for it to prompt me to choose an existing text to add the length of the line to the text.

So basically I have a wall outline with the wall number above it. I would like to be able to click a line of the wall to measure it. Then be prompted to click on a multi line or single line text to add the length to the end of the text with spaces and equal sign separating the two. Hopefully be able to keep in feet & inches as shown below or based on what the drawing Units are set to?

Sample (Please don't laugh too much at my text drawing skills ):

So the top is the before and the bottom is the after.

If someone knows of a routine that can do this and can point me to it, that would be awesome!

If not, would this be overly complicated for a beginner to attempt to code? I just need some guidance on how to begin. Or someone could code it for me?:wink:

Thanks for any and all help!

-Evan

There are already lisp routines that will measure the length of a line and put that measurement above the line. The only thing you would have to add is the wall number. I think forum member Lee Mac and/or alanjt posted lisp routines that you could study and use as a basis for your new routine.

Both Lee and I have posted similar routines, but why not just use a Dimension with a prefix?

There are already lisp routines that will measure the length of a line and put that measurement above the line. The only thing you would have to add is the wall number. I think forum member Lee Mac and/or alanjt posted lisp routines that you could study and use as a basis for your new routine.

That is the routine that brought me here but it's not 100% what I would like to do. I was browsing through the code but it appeared way over my head. This is the thread that brought me here:

http://www.cadtutor.net/forum/showthread.php?56656-Lisp-help-Selecting-multi-lines-and-labeling-them

Both Lee and I have posted similar routines, but why not just use a Dimension with a prefix?

The builder I am working with wants a separate layout with no dimensions, just text above the walls with the length of the wall with the text. I'm trying to make it as easy as possible on me to suffice the builder.

Set your dims as per Alanjt you can turn off all the line work so only text appears, exploding dims turns it to plain text.

Did you have a look at those lisp routines suggested they may label lots of line in one go, I would then run an alternative lisp that added the wall label so you can pick manually the wall number sequence.

A bit further ahead when you draw lines and then pick a whole bunch at one time they are in the drawn order so if you could regiment your self then you could do what you want in one go automatically labelling the walls in the drawn order. I would probably write two routines (in one program) manual or automatic.

Your lucky day added about 5 lines to this code and now it works if want other changes then probably a good time to learn how to write/change a program. This will work as per my post above either auto pick or manual thanks Lee

: original program by lee mac
; Room and number added by Alan H FEB 2011
(princ "\nTo run type plen3")

(defun c:pLen3 (/ *error* doc spc ss mid tStr tBox tObj lAng)
 (vl-load-com)
 (defun *error* (msg)
   (if
     (not
       (wcmatch
         (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))
     (princ
       (strcat
         "\n<< Error: " msg " >>")))
   (princ))
  (if
    (eq 4
      (logand 4
        (cdr (assoc 70
               (tblsearch "LAYER"
                 (getvar "CLAYER"))))))
   (progn
     (princ "\n<< Current Layer Locked >>") (exit)))
 (setq doc (vla-get-ActiveDocument
             (vlax-get-Acad-Object))
       spc (if
             (zerop
               (vla-get-activespace doc))
             (if (= (vla-get-mspace doc) :vlax-true)
               (vla-get-modelspace doc)
               (vla-get-paperspace doc))
             (vla-get-modelspace doc)))

 (while (not ss)
   (setq ss (ssget '((0 . "*LINE")))))
 (setq tSze (getvar "DIMTXT"))
(setq x 1)
 (foreach Obj
   (mapcar 'vlax-ename->vla-object
     (vl-remove-if 'listp
       (mapcar 'cadr (ssnamex ss))))
   (setq tStr (rtos (vla-get-length Obj) 3 2)
         tBox (textbox
                (list
                  (cons 1 (strcat "room" tStr ".."))
                  (cons 40 tSze)
                  (cons 7 (getvar "TEXTSTYLE")))))
   (setq mid (/ (abs (- (vlax-curve-getEndParam Obj)
                          (vlax-curve-getStartParam Obj))) 2.)
         lAng (angle '(0 0 0) (vlax-curve-getFirstDeriv Obj mid)))
   (cond ((and (> lAng (/ pi 2)) (<= lAng pi))
      (setq lAng (- lAng pi)))
     ((and (> lAng pi) (<= lAng (/ (* 3 pi) 2)))
      (setq lAng (+ lAng pi))))
(setq rnum (rtos X 2 0))
(setq tstr (strcat "ROOM" rnum  tStr))
     (setq tObj
       (vla-addMText spc
         (vlax-3D-point (vlax-curve-getPointatParam Obj mid))
           (- (caadr tBox) (caar tBox)) tStr))
   (vla-put-Height tObj tSze)
   (vla-put-Rotation tObj lAng)
(setq x (+ x 1)) 
)
 (princ)
)

Sorry for the delay in getting back to you guys. Both Kaspersky AV and Google were blocking the page. The last time I was on here, Kaspersky said a virus was blocked from this site. I assume malware in an advertisement was to blame?

Both Lee and I have posted similar routines, but why not just use a Dimension with a prefix?

Thank you, I used your idea of adding a dimension with a prefix of " = " (no quotes but spaces). Then I copied the text from the wall label and edited the dimension to add the copied text.

Set your dims as per Alanjt you can turn off all the line work so only text appears, exploding dims turns it to plain text.

 

Did you have a look at those lisp routines suggested they may label lots of line in one go, I would then run an alternative lisp that added the wall label so you can pick manually the wall number sequence.

 

A bit further ahead when you draw lines and then pick a whole bunch at one time they are in the drawn order so if you could regiment your self then you could do what you want in one go automatically labelling the walls in the drawn order. I would probably write two routines (in one program) manual or automatic.

I use a different program to create the walls in 3D. Then I export the 2D view to AutoCAD to create the layout, so the wall labels are already in place for me. I was looking for a quick way to edit the text that is there with the length of the line.

Your lucky day added about 5 lines to this code and now it works if want other changes then probably a good time to learn how to write/change a program. This will work as per my post above either auto pick or manual thanks Lee

Thank you, I will give it a shot when I get home tonight.

Any good links to review to find out more about Lisp programming?

Hope this help you out with it ......

(defun c:test (/ ss ss1 e d lens adds e1 )
 ; Tharwat 14.02.2011
 (setq lens 0)
 (if (setq ss (ssget "_:L" '((0 . "LINE"))))
   (progn
     (repeat (setq i (sslength ss))
   (while
     (setq ss1 (ssname ss  (setq i (1- i))))
      (setq e (entget ss1))
       (setq d (distance (cdr (assoc 10 e))(cdr (assoc 11 e))))
        (setq lens (+ lens d))
         ))
     (setq adds (entsel "\n Select Text to add lengths to :"))
     (entupd (cdr (assoc -1 (entmod (subst
                      (cons 1 (strcat (cdr (assoc 1 (setq e1 (entget (car adds)))))
                               " = " (rtos lens 4 5)))
                      (assoc 1 e1) e1 )))))
     )
   (princ "\n No lines selected")
   )
 (princ)
 )

Tharwat

Hope this help you out with it ......

I was able to run home at lunch and give it a whirl. It works great! Thank you!!!!

I was able to run home at lunch and give it a whirl. It works great! Thank you!!!!

You're welcome anytime .

Tharwat

i use it and it work perfectly , But i want it to measure the distances in millimeters not feets and inches , can u help me in that?

i use it and it work perfectly , But i want it to measure the distances in millimeters not feets and inches , can u help me in that?

Just change .

This .

(rtos lens 4 5)

To.

(rtos lens 2 5)

wow, that's really usefull , thank you so much , i don't wanna be silly but one last favor , how can we make it replace the old text with the new measure instead of adding the measurements to an exsisting one

wow, that's really usefull , thank you so much , i don't wanna be silly but one last favor , how can we make it replace the old text with the new measure instead of adding the measurements to an exsisting one

You're welcome .

Try this modified one to meet your needs ....

(defun c:test (/ ss i sn e e1 ent lens)
; Tharwat 07.10.2012   ;;;
 (setq lens 0)
 (prompt "\n Select lines ...")
 (if (and (setq ss (ssget "_:L" '((0 . "LINE"))))
          (progn
            (prompt
              "\n Select text object to replace lengths of lines :"
            )
            (setq e (ssget "_+.:S:L" '((0 . "*TEXT"))))
          )
     )
   (progn
     (repeat (setq i (sslength ss))
       (setq sn (ssname ss (setq i (1- i))))
       (setq ent (entget sn))
       (setq
         lens (+ lens
                 (distance (cdr (assoc 10 ent)) (cdr (assoc 11 ent)))
              )
       )
     )
     (entupd
       (cdr
         (assoc
           -1
           (entmod
             (subst
               (cons
                 1
                 (strcat "Lengths = "
                         (rtos lens 2 5)
                 )
               )
               (assoc 1 (setq e1 (entget (ssname e 0))))
               e1
             )
           )
         )
       )
     )
   )
   (cond ((not ss) (princ "\n No lines selected"))
         (t (princ "\n Selection is not Text or nothing selected"))
   )
 )
 (princ)
)

thanks broo

thanks broo

You're welcome

How can we change the lenght units to meter?

Thanks

Hope this help you out with it ......

 

(defun c:test (/ ss ss1 e d lens adds e1 )
 ; Tharwat 14.02.2011
 (setq lens 0)
 (if (setq ss (ssget "_:L" '((0 . "LINE"))))
   (progn
     (repeat (setq i (sslength ss))
   (while
     (setq ss1 (ssname ss  (setq i (1- i))))
      (setq e (entget ss1))
       (setq d (distance (cdr (assoc 10 e))(cdr (assoc 11 e))))
        (setq lens (+ lens d))
         ))
     (setq adds (entsel "\n Select Text to add lengths to :"))
     (entupd (cdr (assoc -1 (entmod (subst
                      (cons 1 (strcat (cdr (assoc 1 (setq e1 (entget (car adds)))))
                               " = " (rtos lens 4 5)))
                      (assoc 1 e1) e1 )))))
     )
   (princ "\n No lines selected")
   )
 (princ)
 )

 

Tharwat

How can we change the lenght units to meter?

Thanks

Try this ...

(defun c:test (/ ss s i e l en)
 ;;    Tharwat 07. Mar. 2014    ;;
 (setq l 0.)
 (if (and (setq ss (ssget "_:L" '((0 . "LINE"))))
          (setq s (car (entsel "\n Select Text to add lengths to :")))
          (if (wcmatch (cdr (assoc 0 (setq en (entget s)))) "*TEXT")
            t
            nil
          )
     )
   (progn
     (repeat (setq i (sslength ss))
       (setq e (entget (ssname ss (setq i (1- i))))
             l (+ l (distance (cdr (assoc 10 e)) (cdr (assoc 11 e))))
       )
     )
     (entupd
       (cdr
         (assoc
           -1
           (entmod
             (subst
               (cons
                 1
                 (strcat (cdr (assoc 1 en))
                         " = "
                         (rtos l 2 2)
                 )
               )
               (assoc 1 en)
               en
             )
           )
         )
       )
     )
   )
 )
 (princ)
)

Try this ...

 

(defun c:test (/ ss s i e l en)
 ;;    Tharwat 07. Mar. 2014    ;;
 (setq l 0.)
 (if (and (setq ss (ssget "_:L" '((0 . "LINE"))))
          (setq s (car (entsel "\n Select Text to add lengths to :")))
          (if (wcmatch (cdr (assoc 0 (setq en (entget s)))) "*TEXT")
            t
            nil
          )
     )
   (progn
     (repeat (setq i (sslength ss))
       (setq e (entget (ssname ss (setq i (1- i))))
             l (+ l (distance (cdr (assoc 10 e)) (cdr (assoc 11 e))))
       )
     )
     (entupd
       (cdr
         (assoc
           -1
           (entmod
             (subst
               (cons
                 1
                 (strcat (cdr (assoc 1 en))
                         " = "
                         (rtos l 2 2)
                 )
               )
               (assoc 1 en)
               en
             )
           )
         )
       )
     )
   )
 )
 (princ)
)

Thanks.That works and one thing more.i wanna change the precision to 3 digits if possible?and a suffix (meter)?