Lisp to insert positional number

I tried that LPS; but the leader line always 'defaults' to one of the circle quadrants, rather than radiating from the centre of the circle (and ending at the circles edge)

It does, but so does your block so thats no difference.

Cheers Dip, I never tried that option! It works, I'm just wondering if there's a way to enter the tag-number while inserting and not having to doubleclick the leader afterwords to change the tag.

When I try it I get a prompt to 'Enter attribute values' for TAGNUMBER. Is your ATTREQ set to 1?

...but so does your block so thats no difference

Yes, and no.

As you can see from the block i uploaded; I have developed a workaround to that issue.

Hi Tiger,

Looking back at my code, I realised that I could tidy it up a bit, and so I have posted a much more user friendly version of the program.

The LISP functions much like before, but you don't have to specify a dwg-scale, and also, you don't have to specify the number of tags - meaning that you can just keep adding tags until you don't specify some tag text.

See what you think, and let me know if this helps at all:

;    .: Nozzle & Equipment Tags :.
;
;        .: by Lee McDonnell :.


(defun c:tg () (c:tktag3)) ; <<-- Program Shortcut

(defun c:tktag3 (/     *error* tagpt tagline linent linest linend 
           tagang cnt tcirc tagcnt tagtxt tcirccent)

   (or (getenv "tag:tsize") (setenv "tag:tsize" (rtos (getvar "TEXTSIZE"))))
   (or (getenv "tag:tcircr") (setenv "tag:tcircr" "4.2"))
   (princ
       (strcat    "\nType \"TAGSET\" to Change Base Variables  --  Current Settings:"
           "\n\tText Height: " (getenv "tag:tsize")
           ",\tText Circle Radius: " (getenv "tag:tcircr")) ; end strcat
   ) ; end princ

;     --- Error Trap ---

     (defun *error* (msg)
        (mapcar 'setvar varLst oldVars)
     (if (= msg "")
         (princ "\nFunction Complete.")
         (princ "\nError or Esc pressed... "))
      (princ)
     ) ; end of *error*

     (setq     varLst  (list "CMDECHO" "CLAYER" "DIMSCALE")
           oldVars (mapcar 'getvar varLst)) ; end setq 

         ;    --- Error Trap ---
       
   (setvar "cmdecho" 0)
   (if (not (tblsearch "LAYER" "TAGLINE"))
   (command "-layer" "m" "TAGLINE" "c" "5" "TAGLINE" ""))
   (if (not (tblsearch "LAYER" "TEXT"))
   (command "-layer" "m" "TEXT" "c" "2" "TEXT" ""))
   (setvar "clayer" "TAGLINE")
       (while
           (/= (setq tagpt (getpoint "\nSelect First Tag Point: ")) nil)
           (prompt "\nSpecify Other Tag Points: ")
           (command "_line" tagpt)
           (while (> (getvar 'CmdActive) 0) (command pause))
           (setq tagline (entlast))
           (setq linent (entget tagline))
           (setq linest (cdr (assoc 10 linent)))
           (setq linend (cdr (assoc 11 linent)))
           (setq tagang (angle linest linend))
           (setq cnt 1)
           (setq tcirc (atof (getenv "tag:tcircr")))
           (while
               (/= (setq tagtxt (getstring (strcat "\nType Text for Tag [" (rtos cnt) "]: "))) "")
               (setq tagtxt (strcase tagtxt))
               (setvar "clayer" "TEXT")
               (setq tcirccent (polar linend tagang (* (- (* cnt 2) 1) tcirc)))
               (command "_circle" "_non" tcirccent tcirc)
               (entmake
                   (list    '(0 . "TEXT")
                       '(8 . "TEXT")
                       (cons 10 tcirccent)
                       (cons 40 (atof (getenv "tag:tsize")))
                       (cons 1 tagtxt)
                       '(50 . 0.0)
                       '(7 . "STANDARD")
                       '(71 . 0)
                       '(72 . 1)
                       '(73 . 2)
                       (cons 11 tcirccent)
                   ) ; end list
               ) ; end entmake
               (setq cnt (+ cnt 1))
               (setq tagtxt "")
           ) ; end while
       ) ; end while
   (setvar "cmdecho" 1)
   (*error* "") ; Credit to CAB for this
   (princ)
) ; end program

; Base Variables

(defun c:tagset (/ tsize tcircr)
   (or (getenv "tag:tsize") (setenv "tag:tsize" (rtos (getvar "TEXTSIZE"))))
   (or (getenv "tag:tcircr") (setenv "tag:tcircr" "4.2"))
   (princ
       (strcat    "\nCurrent Settings:"
           "\n\tText Height: "
           (getenv "tag:tsize")
           ",\tText Circle Radius @ 1:1: "
           (getenv "tag:tcircr")
       ) ; end strcat
   ) ; end princ
   (if    (setq tsize (getreal (strcat "\nSpecify Text Height <" (getenv "tag:tsize") ">: ")))
       (setenv "tag:tsize" (rtos tsize))
   ) ; end if
   (if    (setq tcircr (getreal (strcat "\nSpecify Text Circle Radius <" (getenv "tag:tcircr") ">: ")))
       (setenv "tag:tcircr" (rtos tcircr))
   ) ; end if
   (princ "\nBase Variables Set.")
   (princ)
) ; end program

Attached is an example of how it can be used, if you want to go crazy

Thanks Lee! I'll check it out in a bit!

A few tweaks:

;    .: Nozzle & Equipment Tags :.
;
;        .: by Lee McDonnell :.


(defun c:tg () (c:tktag3)) ; <<-- Program Shortcut

(defun c:tktag3 (/     *error* tagpt tagline linent linest linend 
           tagang cnt tcirc tagcnt tagtxt tcirccent)

   (or (getenv "tag:tsize") (setenv "tag:tsize" (rtos (getvar "TEXTSIZE"))))
   (or (getenv "tag:tcircr") (setenv "tag:tcircr" "4.2"))
   (princ
       (strcat    "\nType \"TAGSET\" to Change Base Variables  --  Current Settings:"
           "\n\tText Height: " (getenv "tag:tsize")
           ",\tText Circle Radius: " (getenv "tag:tcircr")) ; end strcat
   ) ; end princ

;     --- Error Trap ---

     (defun *error* (msg)
        (mapcar 'setvar varLst oldVars)
     (if (= msg "")
         (princ "\nFunction Complete.")
         (princ "\nError or Esc pressed... "))
      (princ)
     ) ; end of *error*

     (setq     varLst  (list "CMDECHO" "CLAYER" "DIMSCALE")
           oldVars (mapcar 'getvar varLst)) ; end setq 

         ;    --- Error Trap ---
       
   (setvar "cmdecho" 0)
   (if (not (tblsearch "LAYER" "TAGLINE"))
   (command "-layer" "m" "TAGLINE" "c" "5" "TAGLINE" ""))
   (if (not (tblsearch "LAYER" "TEXT"))
   (command "-layer" "m" "TEXT" "c" "2" "TEXT" ""))
       (while
           (/= (setq tagpt (getpoint "\nSelect First Tag Point: ")) nil)
           (setvar "clayer" "TAGLINE")
           (prompt "\nSpecify Other Tag Points: ")
           (command "_line" tagpt)
           (while (> (getvar 'CmdActive) 0) (command pause))
           (setq tagline (entlast))
           (setq linent (entget tagline))
           (setq linest (cdr (assoc 10 linent)))
           (setq linend (cdr (assoc 11 linent)))
           (setq tagang (angle linest linend))
           (setq cnt 1)
           (setq tcirc (atof (getenv "tag:tcircr")))
           (while
               (/= (setq tagtxt (getstring (strcat "\nType Text for Tag [" (rtos cnt) "]: "))) "")
               (setq tagtxt (strcase tagtxt))
               (setvar "clayer" "TEXT")
               (setq tcirccent (polar linend tagang (* (- (* cnt 2) 1) tcirc)))
               (command "_circle" "_non" tcirccent tcirc)
               (entmake
                   (list    '(0 . "TEXT")
                       '(8 . "TEXT")
                       (cons 10 tcirccent)
                       (cons 40 (atof (getenv "tag:tsize")))
                       (cons 1 tagtxt)
                       '(50 . 0.0)
                       '(7 . "STANDARD")
                       '(71 . 0)
                       '(72 . 1)
                       '(73 . 2)
                       (cons 11 tcirccent)
                   ) ; end list
               ) ; end entmake
               (setq cnt (+ cnt 1))
               (setq tagtxt "")
           ) ; end while
       ) ; end while
   (setvar "cmdecho" 1)
   (*error* "") ; Credit to CAB for this
   (princ)
) ; end program

; Base Variables

(defun c:tagset (/ tsize tcircr)
   (or (getenv "tag:tsize") (setenv "tag:tsize" (rtos (getvar "TEXTSIZE"))))
   (or (getenv "tag:tcircr") (setenv "tag:tcircr" "4.2"))
   (princ
       (strcat    "\nCurrent Settings:"
           "\n\tText Height: "
           (getenv "tag:tsize")
           ",\tText Circle Radius @ 1:1: "
           (getenv "tag:tcircr")
       ) ; end strcat
   ) ; end princ
   (if    (setq tsize (getreal (strcat "\nSpecify Text Height <" (getenv "tag:tsize") ">: ")))
       (setenv "tag:tsize" (rtos tsize))
   ) ; end if
   (if    (setq tcircr (getreal (strcat "\nSpecify Text Circle Radius <" (getenv "tag:tcircr") ">: ")))
       (setenv "tag:tcircr" (rtos tcircr))
   ) ; end if
   (princ "\nBase Variables Set.")
   (princ)
) ; end program

I know I'm one of the first ones to chant "start a new thread with each new question" but this really is not a new question - I just would like a bit of tweak of the latest code here.

While using the lisp I get a repeated prompt for "Specify Other tag point" - can that be removed? I only need one line from the equpment to the tag.

And I also get "Type text for Tag [2]" - can that also be removed? most often I just want one balloon.

Also I just have one question - would it be too much trouble to change the DText to MText? So I can have several lines of text in one balloon?

I know I'm asking a bit here, but I'll be eternally grateful if someone can amend this lisp for me (being a comlpete lisp-noob myself)

This will accomplish most of your requests... just gotta sort the MTEXT out, but haven't got the time at present

I must admit, I am slightly ashamed of this LISP now - I wrote it a while back and now realise how badly it had been written...

I know I put them in there, but I would now recommend taking out the "Base Variable" section, as this uses "setenv" which will create small files in your registry, which some users may not want.

But I will leave that decision up to you

 ;    .: Nozzle & Equipment Tags :.
 ;
 ;        .: by Lee McDonnell :.

(defun c:tg  (/ olderr *error* varLst oldVars tagpt tagline linent linest linend tagang tcirc tagtxt tcirccent)

 (or (getenv "tag:tsize") (setenv "tag:tsize" (rtos (getvar "TEXTSIZE"))))
 (or (getenv "tag:tcircr") (setenv "tag:tcircr" "4.2"))
 (princ
   (strcat "\nType \"TAGSET\" to Change Base Variables  --  Current Settings:"
       "\n\tText Height: "
       (getenv "tag:tsize")
       ",\tText Circle Radius: "
       (getenv "tag:tcircr")))

 ;     --- Error Trap ---

 (setq    olderr    *error* *error*    errtrap)
 (defun errtrap  (msg)
   (mapcar 'setvar varLst oldVars)
   (setq *error* olderr)
   (if    (= msg "")
     (princ "\nFunction Complete.")
     (princ "\nError or Esc pressed... "))
   (princ))

 (setq    varLst    (list "CMDECHO" "CLAYER")
   oldVars    (mapcar 'getvar varLst))

 ;    --- Error Trap ---

 (setvar "cmdecho" 0)
 (if (not (tblsearch "LAYER" "TAGLINE"))
   (command "-layer" "m" "TAGLINE" "c" "5" "TAGLINE" ""))
 (if (not (tblsearch "LAYER" "TEXT"))
   (command "-layer" "m" "TEXT" "c" "2" "TEXT" ""))
 (while
   (/= (setq tagpt (getpoint "\nSelect First Tag Point: ")) nil)
    (setvar "clayer" "TAGLINE")
    (prompt "\nSpecify Second Point... ")
    (command "_line" tagpt pause "")
    (setq tagline (entlast)
      linent  (entget tagline)
      linest  (cdr (assoc 10 linent))
      linend  (cdr (assoc 11 linent))
      tagang  (angle linest linend)
      tcirc   (atof (getenv "tag:tcircr")))
    (if (/= (setq tagtxt (getstring "\nSpecify Text for Tag: ")) "")
      (progn
    (setq tagtxt (strcase tagtxt))
    (setvar "clayer" "TEXT")
    (setq tcirccent (polar linend tagang tcirc))
    (command "_circle" "_non" tcirccent tcirc)
    (entmake (list    '(0 . "TEXT")
           '(8 . "TEXT")
           (cons 10 tcirccent)
           (cons 40 (atof (getenv "tag:tsize")))
           (cons 1 tagtxt)
           '(50 . 0.0)
           '(7 . "STANDARD")
           '(71 . 0)
           '(72 . 1)
           '(73 . 2)
           (cons 11 tcirccent))))))
 (*error* "")
 (princ))

 ; Base Variables

(defun c:tagset     (/ tsize tcircr)
 (or (getenv "tag:tsize") (setenv "tag:tsize" (rtos (getvar "TEXTSIZE"))))
 (or (getenv "tag:tcircr") (setenv "tag:tcircr" "4.2"))
 (princ
   (strcat "\nCurrent Settings:"
       "\n\tText Height: "
       (getenv "tag:tsize")
       ",\tText Circle Radius @ 1:1: "
       (getenv "tag:tcircr")))
 (if (setq tsize (getreal (strcat "\nSpecify Text Height <" (getenv "tag:tsize") ">: ")))
   (setenv "tag:tsize" (rtos tsize)))
 (if (setq tcircr (getreal (strcat "\nSpecify Text Circle Radius <" (getenv "tag:tcircr") ">: ")))
   (setenv "tag:tcircr" (rtos tcircr)))
 (princ "\nBase Variables Set.")
 (princ))

This will accomplish most of your requests... just gotta sort the MTEXT out, but haven't got the time at present

 

I must admit, I am slightly ashamed of this LISP now - I wrote it a while back and now realise how badly it had been written...

 

I know I put them in there, but I would now recommend taking out the "Base Variable" section, as this uses "setenv" which will create small files in your registry, which some users may not want.

 

But I will leave that decision up to you

 

Hey, it does what I need it to do so it can't be that bad Thanks a bunch mate!

Ok, give this a shot:

 ;    .: Nozzle & Equipment Tags :.
 ;
 ;        .: by Lee McDonnell :.

(defun c:tg  (/ olderr *error* varLst oldVars tagpt tagline linent linest linend tagang tcirc tcirccent t1)

 (or (getenv "tag:tsize") (setenv "tag:tsize" (rtos (getvar "TEXTSIZE"))))
 (or (getenv "tag:tcircr") (setenv "tag:tcircr" "4.2"))
 (princ
   (strcat "\nType \"TAGSET\" to Change Base Variables  --  Current Settings:"
       "\n\tText Height: "
       (getenv "tag:tsize")
       ",\tText Circle Radius: "
       (getenv "tag:tcircr")))

 ;     --- Error Trap ---

 (setq    olderr    *error* *error*    errtrap)
 (defun errtrap  (msg)
   (mapcar 'setvar varLst oldVars)
   (setq *error* olderr)
   (if    (= msg "")
     (princ "\nFunction Complete.")
     (princ "\nError or Esc pressed... "))
   (princ))

 (setq    varLst    (list "CMDECHO" "CLAYER")
   oldVars    (mapcar 'getvar varLst))

 ;    --- Error Trap ---

 (setvar "cmdecho" 0)
 (if (not (tblsearch "LAYER" "TAGLINE"))
   (command "-layer" "m" "TAGLINE" "c" "5" "TAGLINE" ""))
 (if (not (tblsearch "LAYER" "TEXT"))
   (command "-layer" "m" "TEXT" "c" "2" "TEXT" ""))
 (while
   (/= (setq tagpt (getpoint "\nSelect First Tag Point: ")) nil)
    (setvar "clayer" "TAGLINE")
    (prompt "\nSpecify Second Point... ")
    (command "_line" tagpt pause "")
    (setq tagline (entlast)
      linent  (entget tagline)
      linest  (cdr (assoc 10 linent))
      linend  (cdr (assoc 11 linent))
      tagang  (angle linest linend)
      tcirc   (atof (getenv "tag:tcircr")))
    (setvar "clayer" "TEXT")
    (setq tcirccent (polar linend tagang tcirc))
    (command "_circle" "_non" tcirccent tcirc)
    (command "-mtext" tcirccent "H" (getenv "tag:tsize") "J" "MC" "@8.4,0" "")
    (command "_ddedit" (setq t1 (entlast)) "")
    (entmod (subst (cons 10 tcirccent) (assoc 10 (entget t1)) (entget t1))))
 (*error* "")
 (princ))

 ; Base Variables

(defun c:tagset     (/ tsize tcircr)
 (or (getenv "tag:tsize") (setenv "tag:tsize" (rtos (getvar "TEXTSIZE"))))
 (or (getenv "tag:tcircr") (setenv "tag:tcircr" "4.2"))
 (princ
   (strcat "\nCurrent Settings:"
       "\n\tText Height: "
       (getenv "tag:tsize")
       ",\tText Circle Radius @ 1:1: "
       (getenv "tag:tcircr")))
 (if (setq tsize (getreal (strcat "\nSpecify Text Height <" (getenv "tag:tsize") ">: ")))
   (setenv "tag:tsize" (rtos tsize)))
 (if (setq tcircr (getreal (strcat "\nSpecify Text Circle Radius <" (getenv "tag:tcircr") ">: ")))
   (setenv "tag:tcircr" (rtos tcircr)))
 (princ "\nBase Variables Set.")
 (princ))

perfect mate, perfect

Cool. Glad it works how you want it to

I have primarily set the MTEXT window size to 8.4 wide (twice the default circle radius), but this can be altered if you want me to.

Also, the window is drawn from the circle center at first, and so the text may appear off-center when you are editing it. This, however, is corrected after text entry, so that the whole text window is shifted to the center.

Cheers

Lee

Just found a typo - my bad:

 ;    .: Nozzle & Equipment Tags :.
 ;
 ;        .: by Lee McDonnell :.

(defun c:tg  (/ olderr *error* varLst oldVars tagpt tagline linent linest linend tagang tcirc
             tcirccent t1)

 (or (getenv "tag:tsize") (setenv "tag:tsize" (rtos (getvar "TEXTSIZE"))))
 (or (getenv "tag:tcircr") (setenv "tag:tcircr" "4.2"))
 (princ
   (strcat "\nType \"TAGSET\" to Change Base Variables  --  Current Settings:"
           "\n\tText Height: "
           (getenv "tag:tsize")
           ",\tText Circle Radius: "
           (getenv "tag:tcircr")))

 ;     --- Error Trap ---

 (setq olderr  *error*
       *error* errtrap)
 (defun errtrap  (msg)
   (mapcar 'setvar varLst oldVars)
   (setq *error* olderr)
   (if (= msg "")
     (princ "\nFunction Complete.")
     (princ "\nError or Esc pressed... "))
   (princ))

 (setq varLst  (list "CMDECHO" "CLAYER")
       oldVars (mapcar 'getvar varLst))

 ;    --- Error Trap ---

 (setvar "cmdecho" 0)
 (if (not (tblsearch "LAYER" "TAGLINE"))
   (command "-layer" "m" "TAGLINE" "c" "5" "TAGLINE" ""))
 (if (not (tblsearch "LAYER" "TEXT"))
   (command "-layer" "m" "TEXT" "c" "2" "TEXT" ""))
 (while
   (/= (setq tagpt (getpoint "\nSelect First Tag Point: ")) nil)
    (setvar "clayer" "TAGLINE")
    (prompt "\nSpecify Second Point... ")
    (command "_line" tagpt pause "")
    (setq tagline (entlast)
          linent  (entget tagline)
          linest  (cdr (assoc 10 linent))
          linend  (cdr (assoc 11 linent))
          tagang  (angle linest linend)
          tcirc   (atof (getenv "tag:tcircr")))
    (setvar "clayer" "TEXT")
    (setq tcirccent (polar linend tagang tcirc))
    (command "_circle" "_non" tcirccent tcirc)
    (command "-mtext" tcirccent "H" (getenv "tag:tsize") "J" "MC" "@8.4,0" "")
    (command "_ddedit" (setq t1 (entlast)) "")
    (entmod (subst (cons 10 tcirccent) (assoc 10 (entget t1)) (entget t1))))
 (errtrap "")
 (princ))

 ; Base Variables

(defun c:tagset  (/ tsize tcircr)
 (or (getenv "tag:tsize") (setenv "tag:tsize" (rtos (getvar "TEXTSIZE"))))
 (or (getenv "tag:tcircr") (setenv "tag:tcircr" "4.2"))
 (princ
   (strcat "\nCurrent Settings:"
           "\n\tText Height: "
           (getenv "tag:tsize")
           ",\tText Circle Radius @ 1:1: "
           (getenv "tag:tcircr")))
 (if (setq tsize (getreal (strcat "\nSpecify Text Height <" (getenv "tag:tsize") ">: ")))
   (setenv "tag:tsize" (rtos tsize)))
 (if
   (setq tcircr (getreal (strcat "\nSpecify Text Circle Radius <" (getenv "tag:tcircr") ">: ")))
    (setenv "tag:tcircr" (rtos tcircr)))
 (princ "\nBase Variables Set.")
 (princ))

Here is a dynamic block I use for item balloons.

Hope you like!!

ITA.dwg