Tiger Posted November 27, 2008 Author Share Posted November 27, 2008 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. Quote Link to comment Share on other sites More sharing options...
lpseifert Posted November 27, 2008 Share Posted November 27, 2008 When I try it I get a prompt to 'Enter attribute values' for TAGNUMBER. Is your ATTREQ set to 1? Quote Link to comment Share on other sites More sharing options...
NBC Posted November 27, 2008 Share Posted November 27, 2008 ...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. Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted November 27, 2008 Share Posted November 27, 2008 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 Quote Link to comment Share on other sites More sharing options...
Tiger Posted November 28, 2008 Author Share Posted November 28, 2008 Thanks Lee! I'll check it out in a bit! Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted November 28, 2008 Share Posted November 28, 2008 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 Quote Link to comment Share on other sites More sharing options...
Tiger Posted February 19, 2009 Author Share Posted February 19, 2009 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) Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted February 19, 2009 Share Posted February 19, 2009 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)) Quote Link to comment Share on other sites More sharing options...
Tiger Posted February 19, 2009 Author Share Posted February 19, 2009 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! Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted February 19, 2009 Share Posted February 19, 2009 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)) Quote Link to comment Share on other sites More sharing options...
Tiger Posted February 19, 2009 Author Share Posted February 19, 2009 perfect mate, perfect Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted February 19, 2009 Share Posted February 19, 2009 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 Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted April 17, 2009 Share Posted April 17, 2009 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)) Quote Link to comment Share on other sites More sharing options...
RadCad Posted August 27, 2010 Share Posted August 27, 2010 Here is a dynamic block I use for item balloons. Hope you like!! ITA.dwg Quote Link to comment Share on other sites More sharing options...
Recommended Posts
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.