Jump to content

label line with layer name and place text

sroberts

By sroberts
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

sroberts Rookie

sroberts

Posted
Posted

Hello I need help please

I need a routine if possible to label a line with the name of its layer and place the text into drawing not just in the command line

thanks for any help

Sherry

Link to comment
Share on other sites
  • Replies 25
  • Created
  • Last Reply

Top Posters In This Topic

  • Lee Mac

    11

  • sroberts

    9

  • alanjt

    3

  • fixo

    1

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

titoprax
titoprax

Helloooo guys cad-world. I like the lisp LAYTEXT. Is it possible to put more than one text? If a line has a distance X, 2 are inserted or more texts. Is it possible?   Thank

Lee Mac Grand Master

Lee Mac

Posted
Posted

Modification of my existing routine:

 

;;;==========================[ MacAlign.lsp ]========================== 
;;; Author: Copyright© 2009 Lee McDonnell (Lee Mac)                     
;;;         (Contact @ CADTutor.net, The Swamp.org)                     
;;; Version:  1.0 June 13, 2009                                         
;;;           2.0 June 14, 2009                                         
;;;           3.0 June 16, 2009                                         
;;;           4.0 June 16, 2009                                         
;;;           5.0 July 22, 2009                                         
;;; Purpose: To Align Text to a Curve                                   
;;; Sub_Routines: getpoint_or_text.lsp by Charles Alan Butler (CAB)     
;;;                                                                     
;;; Additional Features:                                                
;;; Use +/- to Alter Text Offset                                        
;;; Use "P" to toggle perpendicularity                                  
;;;====================================================================

;;;  MODIFIED TO SET TEXT AS CURVE LAYER  ;;

(defun c:MacAlign (/ *error* doc spc tmp tStr ent cObj
                    tObj gr cPt pt cAng lAng tSze
                  
                   ; *Mac$Str*  }
                   ; *Mac$tOff* } Global Variables
                   ; *Mac$Per*  }

                  )
 (vl-load-com)

 ;; Error Handler

 (defun *error* (msg)
   (and tObj (not (vlax-erased-p tObj))
        (vla-delete tObj))
   (if (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))
     (princ (strcat "\n<< Error: " msg " >>")))
   (redraw) (princ))

 ;; Check for Locked Current Layer

 (if (eq 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (getvar "CLAYER"))))))
   (progn
     (princ "\n<< Current Layer Locked >>") (exit)))

 ;; Get Space & Doc

 (setq doc (vla-get-ActiveDocument
             (vlax-get-Acad-Object))
       spc (if (zerop (vla-get-activespace doc))
             (if (= (vla-get-mspace doc) :vlax-true) ; Vport
               (vla-get-modelspace doc)
               (vla-get-paperspace doc))
             (vla-get-modelspace doc)))

 ;; Set First-time Defaults
 
 (or *Mac$Str*  (setq *Mac$Str* "text"))  
 (or *Mac$Per*  (setq *Mac$Per* (/ pi 2.)))
 (or *Mac$tOff* (setq *Mac$tOff* 1.))
 (or tSze (setq tSze (getvar "TEXTSIZE")))
     
     ;; Get Curve to Align
     
     (while
       (progn
         (setq ent (nentsel "\nSelect Curve: "))
         (cond ((and (vl-consp ent)
                     (vl-position
                       (cdr (assoc 0 (entget (car ent))))
                         '("LINE" "LWPOLYLINE" "POLYLINE" "ARC"
                           "SPLINE" "CIRCLE" "ELLIPSE" "XLINE")))
                (setq cObj (vlax-ename->vla-object (car ent)))
                nil) ; Exit Loop
               (t (princ "\nMissed, Try Again..."))))) ; Keep in Loop

   (setq tStr (vla-get-layer cObj))

     ;; Create Text Object
     
       (vla-put-alignment
         (if tObj tObj
           (setq tObj
             (vla-addText spc tStr
               (vlax-3D-point '(0 0 0)) tSze))) acAlignmentMiddleCenter)
     (setq msg (princ "\n<< Type [+] or [-] for offset, and [P]erpendicular >>"))

     ;; Place Text
           
     (while
       (progn
         (setq gr (grread t 15 0))
         (redraw)        
         (cond ((and (eq 5 (car gr)) (listp (setq cPt (cadr gr))))
                (setq pt (vlax-curve-getClosestPointto cObj cPt))
                (if (and (< 0 (getvar "OSMODE") 16383)
                         (setq osPt (osnap pt (osLst (getvar "OSMODE")))))
                  (osMark osPt))
                (setq cAng (angle pt cPt)
                      lAng (+ cAng *Mac$Per*))

                ;; Correct Angle
                
                (cond ((and (> lAng (/ pi 2)) (<= lAng pi))
                       (setq lAng (- lAng pi)))
                      ((and (> lAng pi) (<= lAng (/ (* 3 pi) 2)))
                       (setq lAng (+ lAng pi))))
                
                (vla-move tObj
                  (vla-get-TextAlignmentPoint tObj)
                    (vlax-3D-point
                      (polar pt cAng (* tSze *Mac$tOff*))))
                (vla-put-Rotation tObj lAng) t)

               ((eq 2 (car gr))
                (cond ((vl-position (cadr gr) '(43 61))
                       (setq *Mac$tOff*
                         (+ (/ 1 10.) *Mac$tOff*)))
                      ((eq (cadr gr) 45)
                       (setq *Mac$tOff*
                         (-  *Mac$tOff* (/ 1 10.))))
                      ((vl-position (cadr gr) '(80 112))
                       (setq *Mac$Per* (- (/ pi 2.) *Mac$Per*)))
                      ((eq 6 (cadr gr))
                       (cond ((< 0 (getvar "OSMODE") 16384)
                              (setvar "OSMODE" (+ 16384 (getvar "OSMODE")))
                              (princ (strcat "\n<Osnap off>" msg)))
                             (t (setvar "OSMODE" (- (getvar "OSMODE") 16384))
                                (princ (strcat "\n<Osnap on>" msg)))) t)
                      ((vl-position (cadr gr) '(13 32)) nil)
                      (t)))

               ((eq 3 (car gr))
                (if (and (< 0 (getvar "OSMODE") 16383)
                         (setq osPt (osnap pt (osLst (getvar "OSMODE")))))
                  (progn
                    (osMark osPt)
                    (setq cAng (angle pt cPt)
                          lAng (+ cAng *Mac$Per*))

                  ;; Correct Angle
                
                    (cond ((and (> lAng (/ pi 2)) (<= lAng pi))
                           (setq lAng (- lAng pi)))
                          ((and (> lAng pi) (<= lAng (/ (* 3 pi) 2)))
                           (setq lAng (+ lAng pi))))
                    
                    (vla-move tObj
                      (vla-get-TextAlignmentPoint tObj)
                        (vlax-3D-point
                          (polar ospt cAng (* tSze *Mac$tOff*))))
                    (vla-put-Rotation tObj lAng)))

                nil)
               
               ((eq 25 (car gr)) nil) (t))))

 (redraw) (princ))

(defun oSlst (os / str cnt)
 (setq str "" cnt 0)
 (if (< 0 os 16383)
   (foreach mod '("_end" "_mid" "_cen" "_nod" "_qua"
                  "_int" "_ins" "_per" "_tan" "_nea"
                  "_non" "_app" "_ext" "_par")
     (if (not (zerop (logand (expt 2 cnt) os)))
       (setq str (strcat str mod (chr 44))))
     (setq cnt (1+ cnt))))
 (vl-string-right-trim (chr 44) str))

(defun osMark (pt / drft osSz osCol ratio bold glst i)
 (setq drft (vla-get-drafting
              (vla-get-preferences
                (vlax-get-acad-object)))
       osSz (vla-get-AutoSnapMarkerSize drft)
       oscol (vla-get-AutoSnapMarkerColor drft)
       ratio (/ (getvar "VIEWSIZE")
              (cadr (getvar "SCREENSIZE")))
       bold (mapcar
              (function
                (lambda (x)
                  (* x ratio))) (list (+ osSz 0.5) osSz (- osSz 0.5))) i 0)

 (repeat 50
   (setq glst
     (cons
       (polar '(0 0 0) (* i (/ pi 25.)) 1.) glst) i (1+ i)))      

 (foreach x bold
    (grvecs (append (list oscol) glst (cdr glst) (list (car glst)))
            (list (list  x  0.0 0.0 (car pt))
                  (list 0.0  x  0.0 (cadr pt))
                  (list 0.0 0.0 1.0 0.0)
                  (list 0.0 0.0 0.0 1.0)))))

(vl-load-com)

Link to comment
Share on other sites
sroberts Rookie

sroberts

Posted
  • Author
Posted

Lee, thank you so much it works great. :D

I have a question is it possible to setup to select more than one line at a time, so i could label all at once?

Thank you again

Sherry

Link to comment
Share on other sites
Lee Mac Grand Master

Lee Mac

Posted
Posted
Lee, thank you so much it works great. :D

I have a question is it possible to setup to select more than one line at a time, so i could label all at once?

Thank you again

Sherry

 

Thanks Sherry,

 

Multiple selection is not possible with the current placement method, as each text is aligned to each object, and so multiple text cannot be aligned simultaneously (without tons more code).

 

If you wanted the text to be in a set position every time, then multiple selection can be achieved with relatively less code.

 

Lee

Link to comment
Share on other sites
sroberts Rookie

sroberts

Posted
  • Author
Posted
Thanks Sherry,

 

Multiple selection is not possible with the current placement method, as each text is aligned to each object, and so multiple text cannot be aligned simultaneously (without tons more code).

 

If you wanted the text to be in a set position every time, then multiple selection can be achieved with relatively less code.

 

Lee

 

 

Hi Lee

If you don't mind revising the one for less code so it is in a set position, I would greatly appreciate it.

Thank you Sherry

Link to comment
Share on other sites
Lee Mac Grand Master

Lee Mac

Posted
Posted
Hi Lee

If you don't mind revising the one for less code so it is in a set position, I would greatly appreciate it.

Thank you Sherry

 

It would have to be a new program, but I don't mind if I have the time.

 

Where would the fixed position be? The midpoint of the line?

Link to comment
Share on other sites
sroberts Rookie

sroberts

Posted
  • Author
Posted
It would have to be a new program, but I don't mind if I have the time.

 

Where would the fixed position be? The midpoint of the line?

 

The midpoint would be good.

I will use both programs just for different applications. Thank you so much for taking the time to do all this.

Sherry

Link to comment
Share on other sites
Lee Mac Grand Master

Lee Mac

Posted
Posted

Please try this:

 

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

Link to comment
Share on other sites
sroberts Rookie

sroberts

Posted
  • Author
Posted
Please try this:

 

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

 

 

 

Lee,

I recieved this message when trying to use the lisp

** Error: bad argument type: numberp: nil **

Link to comment
Share on other sites
Lee Mac Grand Master

Lee Mac

Posted
Posted
Other than the text being tiny (Annotative), it works fine for me.

 

I just used TEXTSIZE variable, but gave the option at the top of the code... but glad it doesn't error :)

Link to comment
Share on other sites
sroberts Rookie

sroberts

Posted
  • Author
Posted
Just tested it again, I can't seem to get it to fail... :(

 

At what point does the message occur?

 

 

Okay back from lunch

I retested and it works if i select one line at a time but I can't window those lines or i get this message

** Error: bad argument type: numberp: nil **

 

and thats okay i can use it that way

thanks Sherry

Link to comment
Share on other sites
alanjt Grand Master

alanjt

Posted
Posted
I just used TEXTSIZE variable, but gave the option at the top of the code... but glad it doesn't error :)

 

Just stating what happened. There's nothing wrong with the code.

Link to comment
Share on other sites
Lee Mac Grand Master

Lee Mac

Posted
Posted
Okay back from lunch

I retested and it works if i select one line at a time but I can't window those lines or i get this message

** Error: bad argument type: numberp: nil **

 

and thats okay i can use it that way

thanks Sherry

 

That is really weird... there should be nothing to say you cannot window the lines... I have never come across that before :geek:

Link to comment
Share on other sites
sroberts Rookie

sroberts

Posted
  • Author
Posted
PICKAUTO maybe? But it shouldn't cause an error..

 

 

Okay I did a reboot and it seems to be working now.

sorry i should have thought of that first.

thank you for your time and patiences

Sherry

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...