Layer name to text

December 8, 2015

Hi guys,

I found this LISP by Lee Mac and I am looking for some help to modify it. It works great as is just need to tweak it to my needs.

I receive tax maps all the time from a few towns and each lot is on it's own layer and the layer name is the lot and block. ex. Layer name: 2003298-10 where 2003 is the year, 298 is the block and 10 is the lot.

I am looking to modify the code so that when I select one of the lots (which is a polyline, btw) it will label the polyline appropriately.

As of now the code works and labels the line with the layer name. I want to modify it so it prompts the user for the text size, breaks the label by removing the first four char, adding Block to the next three char, drop the - and add lot to the last 2 char. Then place the text, as best it can, in the center of the polyline lot, with the text rotation angle set to snapang or viewtwist variable.

I hope I explained that well, any help on any of these would be great.

Thanks,

Cylis0509

;; LayText.lsp by Lee McDonnell, 03.12.2009

;; Function will display layer information
;; at midpoint of every line selected.

(defun c:LayText (/ *error* mk_txt

DOC ENT I IPT LANG OFAC P SPC SS TOBJ TSZE UFLAG)

(vl-load-com)

(setq oFac 0.7) ;; Offset Factor
(setq tSze nil) ;; Text Size ~ nil for TEXTSIZE Variable

(defun *error* (msg)
(and uFlag (vla-EndUndoMark doc))
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **")))
(princ)) 

(defun mk_txt (p v) (vla-addText spc v (vlax-3D-point p) tSze))

(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)))

(or tSze (setq tSze (getvar "TEXTSIZE")))

(if (setq i -1 ss (ssget '((0 . "*LINE,ARC,CIRCLE,ELLIPSE"))))
(progn
(setq uFlag (not (vla-StartUndoMark doc)))

(while (setq ent (ssname ss (setq i (1+ i))))

(setq iPt (vlax-curve-getPointatDist ent
(/ (- (vlax-curve-getDistatParam ent
(vlax-curve-getEndParam ent))
(vlax-curve-getDistatParam ent
(vlax-curve-getStartParam ent))) 2.)))

(setq lAng (angle '(0 0 0) (vlax-curve-getFirstDeriv ent
(vlax-curve-getParamatPoint ent iPt))))

(if (equal lAng (/ pi 2.) 0.001) (setq lAng (/ pi 2.)))
(if (equal lAng (/ (* 3 pi) 2.) 0.001) (setq lAng (/ (* 3 pi) 2.)))

(cond ( (and (> lAng (/ pi 2)) (<= lAng pi)) (setq lAng (- lAng pi)))

( (and (> lAng pi) (<= lAng (/ (* 3 pi) 2))) (setq lAng (+ lAng pi))))

(setq tObj (mk_txt (setq p (polar iPt (+ lAng (/ pi 2.)) (* oFac tSze)))
(vla-get-Layer (vlax-ename->vla-object ent))))

(vla-put-Alignment tObj acAlignmentMiddleCenter)
(vla-put-TextAlignmentPoint tObj (vlax-3D-point p))
(vla-put-Rotation tObj lAng))

(setq uFlag (vla-EndUndoMark doc))))

(princ))

December 8, 2015

Ok so I have figured out how to prompt for the text size and set the label to the snapangle of the drawing. It is working great. But I am still struggling on how to center the text on the object, and how to truncate the layer name into the format I would like.

;; LayText.lsp by Lee McDonnell, 03.12.2009

;; Function will display layer information
;; at midpoint of every line selected.

(defun c:LBLL (/ *error* mk_txt

DOC ENT I IPT LANG OFAC P SPC SS TOBJ TSZE UFLAG)

(vl-load-com)

(setq oFac 0.7) ;; Offset Factor
(setq tSze (getint "Enter the text size for the label: "))

(defun *error* (msg)
(and uFlag (vla-EndUndoMark doc))
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **")))
(princ)) 

(defun mk_txt (p v) (vla-addText spc v (vlax-3D-point p) tSze))

(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)))

(if (setq i -1 ss (ssget '((0 . "*LINE,ARC,CIRCLE,ELLIPSE"))))
(progn
(setq uFlag (not (vla-StartUndoMark doc)))

(while (setq ent (ssname ss (setq i (1+ i))))

(setq iPt (vlax-curve-getPointatDist ent
(/ (- (vlax-curve-getDistatParam ent
(vlax-curve-getEndParam ent))
(vlax-curve-getDistatParam ent
(vlax-curve-getStartParam ent))) 2.)))

(setq lAng (getvar "snapang"))

(setq tObj (mk_txt (setq p (polar iPt (+ lAng (/ pi 2.)) (* oFac tSze)))
(vla-get-Layer (vlax-ename->vla-object ent))))

(vla-put-Alignment tObj acAlignmentMiddleCenter)
(vla-put-TextAlignmentPoint tObj (vlax-3D-point p))
(vla-put-Rotation tObj lAng))

(setq uFlag (vla-EndUndoMark doc))))

(princ))

December 8, 2015

To truncate a string , use SUBTR function.

December 8, 2015

To truncate a string , use SUBTR function.

Hi Tharwat,

I get that, but where I'm having trouble is where in the code do I start that "formatting" for lack of a better term.

Thanks,

Cylis0509

December 8, 2015

Hi guys,

I found this LISP by Lee Mac and I am looking for some help to modify it. It works great as is just need to tweak it to my needs.

I receive tax maps all the time from a few towns and each lot is on it's own layer and the layer name is the lot and block. ex. Layer name: 2003298-10 where 2003 is the year, 298 is the block and 10 is the lot.

I am looking to modify the code so that when I select one of the lots (which is a polyline, btw) it will label the polyline appropriately.

As of now the code works and labels the line with the layer name. I want to modify it so it prompts the user for the text size, breaks the label by removing the first four char, adding Block to the next three char, drop the - and add lot to the last 2 char. Then place the text, as best it can, in the center of the polyline lot, with the text rotation angle set to snapang or viewtwist variable.

I hope I explained that well, any help on any of these would be great.

Thanks,

Cylis0509
;; LayText.lsp by Lee McDonnell, 03.12.2009

;; Function will display layer information
;; at midpoint of every line selected.

(defun c:LayText (/ *error* mk_txt

DOC ENT I IPT LANG OFAC P SPC SS TOBJ TSZE UFLAG)

(vl-load-com)

(setq oFac 0.7) ;; Offset Factor
(setq tSze nil) ;; Text Size ~ nil for TEXTSIZE Variable

(defun *error* (msg)
(and uFlag (vla-EndUndoMark doc))
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **")))
(princ)) 

(defun mk_txt (p v) (vla-addText spc v (vlax-3D-point p) tSze))

(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)))

(or tSze (setq tSze (getvar "TEXTSIZE")))

(if (setq i -1 ss (ssget '((0 . "*LINE,ARC,CIRCLE,ELLIPSE"))))
(progn
(setq uFlag (not (vla-StartUndoMark doc)))

(while (setq ent (ssname ss (setq i (1+ i))))

(setq iPt (vlax-curve-getPointatDist ent
(/ (- (vlax-curve-getDistatParam ent
(vlax-curve-getEndParam ent))
(vlax-curve-getDistatParam ent
(vlax-curve-getStartParam ent))) 2.)))

(setq lAng (angle '(0 0 0) (vlax-curve-getFirstDeriv ent
(vlax-curve-getParamatPoint ent iPt))))

(if (equal lAng (/ pi 2.) 0.001) (setq lAng (/ pi 2.)))
(if (equal lAng (/ (* 3 pi) 2.) 0.001) (setq lAng (/ (* 3 pi) 2.)))

(cond ( (and (> lAng (/ pi 2)) (<= lAng pi)) (setq lAng (- lAng pi)))

( (and (> lAng pi) (<= lAng (/ (* 3 pi) 2))) (setq lAng (+ lAng pi))))

(setq tObj (mk_txt (setq p (polar iPt (+ lAng (/ pi 2.)) (* oFac tSze)))
(vla-get-Layer (vlax-ename->vla-object ent))))

(vla-put-Alignment tObj acAlignmentMiddleCenter)
(vla-put-TextAlignmentPoint tObj (vlax-3D-point p))
(vla-put-Rotation tObj lAng))

(setq uFlag (vla-EndUndoMark doc))))

(princ))

i will recommend you to move to Annotative text (introduced in 2008 i think ..), this way you can get the desired text height in model and paper without any issues. then use some label line with layer name lisp. then use find and replace with the FIND command. about adding blocks , not sure what you mean?

December 8, 2015

You have a layer name as you have mentioned before 2003298-10 and firstly you want to remove the first four numbers which represent a year. so what about the rest ?

eg.

(substr "2003298-10" 5)

returns;

"298-10"

Show me the desired final string you are after.

December 8, 2015

You have a layer name as you have mentioned before 2003298-10 and firstly you wan to remove the first four numbers which represent a year. so about the rest ?

eg.
(substr "2003298-10" 5)
returns;

"298-10"

Show me the desired final string you are after.

Thank you Tharwat,

The ultimate format that I would like to achieve using the same example is: Lot 10 Block 298 on two lines.

I'm also really struggling on how to get the user to pick the label location.

December 8, 2015

Let's get this straight before giving any solution . okay?

Do all the layer names have the same format or length of chars ? I mean , four numbers = year , three numbers = Block , two numbers = Lot ?

You are talking about one layer , or all the other layers have the same LENGTH of chars?

December 8, 2015

They do vary slightly. It will always be four numbers = year , three numbers = Block , varies = Lot, but lot could be everything after the "-".

$c:\Capture.png$

Ok so that didn't work... wanted to show you a pic of the layer dialog box.

Edited December 8, 2015 by Cylis0509
Photo did not upload.

December 8, 2015

Attached is an image of the layer dialog

December 8, 2015

Okay , replace this:

(setq tObj (mk_txt
                (setq p (polar iPt (+ lAng (/ pi 2.)) (* oFac tSze)))
                (vla-get-Layer (vlax-ename->vla-object ent))
              )
       )

with this:

(setq lay (vla-get-Layer (vlax-ename->vla-object ent))
             tObj (mk_txt
                (setq p (polar iPt (+ lAng (/ pi 2.)) (* oFac tSze)))
                (strcat "Lot " (substr lay 9) " Block " (substr lay 5 3))
              )
       )

And finally , add the variable to be localized like this:

(defun c:LBLL (/ *error* mk_txt DOC ENT I IPT LANG OFAC P SPC SS TOBJ TSZE UFLAG [color=red][b]lay[/b][/color])

December 8, 2015

Works like a dream!! Thank you so much! Not to push my luck here but...

Is there anyway to make it two lines or mtext?

December 8, 2015

Works like a dream!! Thank you so much! Not to push my luck here but...

Good for you.

Is there anyway to make it two lines or mtext?

Sure, just add \\P before chars that you would like to take the chars in a new line.

December 8, 2015

Ok perfect. Thank you so much Tharwat!

Again may be pushing my luck here. Le t me know if I'm asking too many questions.

This should be the last one. I would like the LISP to loop from the point after they select the text height. So they select the object then the label location, command continues asks for next object then label location. Where does my while statement start and end?

December 8, 2015

Your last request is not that clear to me.

December 8, 2015

Your last request is not that clear to me.

I'm sorry...

Currently the routine stops after labeling one polyline and the user has to initate the command again, select the text height again, and then another polyline.

I would love for the command to continue until exited by the user. After placing the first label it goes back and asks for the next polyline to label and point to place the label, so on and so on. That way they can go lot by lot. Select pick label location, select pick label location.

I hope that makes sense.

December 8, 2015

Good for you.

Sure, just add \\P before chars that you would like to take the chars in a new line.

Hey that doesn't seem to be working.

(strcat "Lot " (substr lay 9) "\\PBlock " (substr lay 5 3))

Results: Lot 1\PBlock 298

I have also tried:

(strcat "Lot " (substr lay 9) "\\P" "Block " (substr lay 5 3)

Results: the same.

I have tried \p \n in all combination. Cant seem to get it to work. I know its something simple but...

December 9, 2015

To repeat think about changing the While to be further up in procedure, also you may be better with using the while with a entsel rather than ssget as you are only looking at one object at a time. Search here there is a centroid lisp by GP which does what you want.

; something like this pick nothing to exit.
(while (setq obj (entsel "pick line arc pline etc or nothing "))
(setq layname (vla-get-layer (vlax-ename->vla-object (car obj)))
....check valid object
.....
) ;endwhile

December 9, 2015

Try this:

(defun c:lbll (/ *error* mk_txt doc ent i ipt lang ofac p spc ss tobj
               uflag lay
             )
;; Modified by Tharwat   ;;
 (defun *error* (msg)
   (if doc
     (vla-endundomark doc)
   )
   (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
       (princ (strcat "\n** Error: " msg " **"))
   )
   (princ)
 )

 (defun mk_txt (p v)
   (vla-addmtext spc (vlax-3d-point p) 0.0 v)
 )

 (setq doc  (vla-get-activedocument
              (vlax-get-acad-object)
            )
       spc  (vla-get-block (vla-get-activelayout doc))
       ofac 0.7
       lang (getvar "snapang")
 )
 (setq *hgt* (if *hgt*
               *hgt*
               1.0
             )
 )
 (vla-startundomark doc)
 (if (progn
       (initget 6)
       (setq *hgt*
              (cond
                ((getdist (strcat "\nEnter the text size for the label ["
                                  (rtos *hgt* 2 2)
                                  "] :"
                          )
                 )
                )
                (t *hgt*)
              )
       )
       (setq *hgt* *hgt*)
     )
   (while (setq ss (ssget "_+.:S:E" '((0 . "*LINE,ARC,CIRCLE,ELLIPSE"))))
     (setq ipt (vlax-curve-getpointatdist
                 (setq ent (ssname ss 0))
                 (/ (- (vlax-curve-getdistatparam
                         ent
                         (vlax-curve-getendparam ent)
                       )
                       (vlax-curve-getdistatparam
                         ent
                         (vlax-curve-getstartparam ent)
                       )
                    )
                    2.
                 )
               )
           lay (vla-get-layer (vlax-ename->vla-object ent))
     )
     (if
       (setq
         tobj
          (mk_txt
            (setq p (polar ipt (+ lang (/ pi 2.)) (* ofac *hgt*)))
            (strcat "Lot "
                    (substr lay 9)
                    "\\PBlock "
                    (substr lay 5 3)
            )
          )
       )
        (progn
          (vla-put-height tobj *hgt*)
          (vla-put-attachmentpoint tobj 5)
          (vla-put-rotation tobj lang)
        )
     )
   )
 )
 (vla-endundomark doc)
 (princ)
)(vl-load-com)

Sign In

Layer name to text

Recommended Posts

Cylis0509

Cylis0509

Tharwat

Cylis0509

Zac Davis

Tharwat

Cylis0509

Tharwat

Cylis0509

Cylis0509

Tharwat

Cylis0509

Tharwat

Cylis0509

Tharwat

Cylis0509

Cylis0509

BIGAL

Tharwat

Join the conversation

Tutorials

Forums

Activity