JDRBWA Posted February 5, 2009 Author Posted February 5, 2009 yes, if they should need some odd door tag that would be set on both sides. Quote
Lee Mac Posted February 5, 2009 Posted February 5, 2009 Ok try this - although the LISP is getting messy now with so many alterations There is probably a better way to write it, but it would mean re-writing most of the LISP, so try this for now (defun c:tagger (/ *error* vLst oVars ans pTxt sNum sNumt sTxt cnt iPt drTag bubTag drTagLst bubTagLst lAns 1pt 2pt lAng chrLst sChr) (vl-load-com) (defun *error* (msg) (if oVars (mapcar 'setvar vLst oVars)) (if (eq "" msg) (princ "\n<< Function Complete >>") (princ (strcat "Error: " (strcase msg)))) (princ)) (setq vLst (list "OSMODE" "CLAYER" "ATTREQ" "BLIPMODE" "CMDECHO") oVars (mapcar 'getvar vLst)) (mapcar 'setvar vLst (list 0 "0" 0 0 0)) (mapcar 'makelay '("A-DOOR-IDEN" "S-GRID-IDEN" "S-GRID") '("5" "4" "2")) (if (and (tblsearch "BLOCK" "Tagdoor1") (tblsearch "BLOCK" "Grdbub01")) (progn (if (not TG:oans) (setq TG:oans "Door")) (if (not TG:olans) (setq TG:olans "Yes")) (initget "Door Bubble") (setq ans (getkword (strcat "\nSpecify Tag Type [Door/Bubble] <" TG:oans ">: "))) (if (not ans) (setq ans TG:oans) (setq TG:oans ans)) (if (and (setq pTxt (getstring t "\nSpecify Prefix Text <Enter for no Prefix>: ") sNum (getstring "\nSpecify Incremental String: ") sTxt (getstring t "\nSpecify Suffix Text <Enter for no Suffix>: "))) (progn (if (txt2num sNum) (setq sNum (txt2num sNum)) (setq sNumt (vl-string->list sNum))) (setq cnt 0) (cond ((= ans "Bubble") (initget "Yes No") (setq lAns (getkword (strcat "\nGrid-Line? [Yes/No] <" TG:olans ">: "))) (if (not lAns) (setq lAns TG:olans) (setq TG:olans lAns)) (cond ((= lAns "No") (if sNumt (progn (setq sChr (last sNumt)) (while (and (setq iPt (getpoint "\nSelect Point for Symbol > ")) (< (+ sChr cnt) 90)) (setvar "clayer" "S-GRID-IDEN") (command "-insert" "Grdbub01" iPt "" "" "") (setq bubTag (entnext (entlast))) (while (/= "SEQEND" (cdadr (setq bubTagLst (entget bubTag)))) (if (= "GRIDNUM" (cdr (assoc 2 bubTagLst))) (entmod (subst (cons 1 (strcat pTxt (chr (+ sChr cnt)) sTxt)) (assoc 1 bubTagLst) bubTagLst))) (setq bubTag (entnext bubTag))) (command "_regenall") (setq cnt (1+ cnt)))) (while (setq iPt (getpoint "\nSelect Point for Symbol > ")) (setvar "clayer" "S-GRID-IDEN") (command "-insert" "Grdbub01" iPt "" "" "") (setq bubTag (entnext (entlast))) (while (/= "SEQEND" (cdadr (setq bubTagLst (entget bubTag)))) (if (= "GRIDNUM" (cdr (assoc 2 bubTagLst))) (entmod (subst (cons 1 (strcat pTxt (rtos (+ sNum cnt) 2 0) sTxt)) (assoc 1 bubTagLst) bubTagLst))) (setq bubTag (entnext bubTag))) (command "_regenall") (setq cnt (1+ cnt))))) ((= lAns "Yes") (if sNumt (progn (setq sChr (last sNumt)) (while (and (setq 1pt (getpoint "\nSpecify Grid-Line First Point > ")) (setq 2pt (getpoint 1pt "\nSpecify Second Grid-Line Point > ")) (< (+ sChr cnt) 90)) (setvar "clayer" "S-GRID") (command "_line" 1pt 2pt "") (setq grLin (entlast) lAng (angle 1pt 2pt) iPt (polar 2pt lAng 0.5)) (setvar "clayer" "S-GRID-IDEN") (command "-insert" "Grdbub01" iPt "" "" "") (setq bubTag (entnext (entlast))) (while (/= "SEQEND" (cdadr (setq bubTagLst (entget bubTag)))) (if (= "GRIDNUM" (cdr (assoc 2 bubTagLst))) (entmod (subst (cons 1 (strcat pTxt (chr (+ sChr cnt)) sTxt)) (assoc 1 bubTagLst) bubTagLst))) (setq bubTag (entnext bubTag))) (command "_regenall") (setq cnt (1+ cnt)))) (while (and (setq 1pt (getpoint "\nSpecify Grid-Line First Point > ")) (setq 2pt (getpoint 1pt "\nSpecify Second Grid-Line Point > "))) (setvar "clayer" "S-GRID") (command "_line" 1pt 2pt "") (setq grLin (entlast) lAng (angle 1pt 2pt) iPt (polar 2pt lAng 0.5)) (setvar "clayer" "S-GRID-IDEN") (command "-insert" "Grdbub01" iPt "" "" "") (setq bubTag (entnext (entlast))) (while (/= "SEQEND" (cdadr (setq bubTagLst (entget bubTag)))) (if (= "GRIDNUM" (cdr (assoc 2 bubTagLst))) (entmod (subst (cons 1 (strcat pTxt (rtos (+ sNum cnt) 2 0) sTxt)) (assoc 1 bubTagLst) bubTagLst))) (setq bubTag (entnext bubTag))) (command "_regenall") (setq cnt (1+ cnt))))))) ((= ans "Door") (setq chrLst (vl-string->list sTxt)) (if chrLst (setq sChr (last chrLst)) (setq sChr 65)) (while (and (setq iPt (getpoint "\nSelect Point for Symbol > ")) (< (+ sChr cnt) 91)) (setvar "clayer" "A-DOOR-IDEN") (command "-insert" "Tagdoor1" iPt "" "" "") (setq drTag (entnext (entlast))) (while (/= "SEQEND" (cdadr (setq drTagLst (entget drTag)))) (if (= "DR1NUM" (cdr (assoc 2 drTagLst))) (entmod (subst (cons 1 (strcat pTxt (rtos sNum 2 0) (chr (+ sChr cnt)))) (assoc 1 drTagLst) drTagLst))) (setq drTag (entnext drTag))) (command "_regenall") (setq cnt (1+ cnt)))))))) (princ "\n<!> One or More Blocks not Found <!>")) (*error* "") (princ)) (defun makelay (x y) (if (not (tblsearch "LAYER" x)) (command "-layer" "M" x "C" y x ""))) (defun txt2num (txt / num) (or (setq num (distof txt 5)) (setq num (distof txt 2)) (setq num (distof txt 1)) (setq num (distof txt 4)) (setq num (distof txt 3)) ) (if (numberp num) num) ) Quote
JDRBWA Posted February 5, 2009 Author Posted February 5, 2009 Yeah, i think we have a couple pots in the fire hehe. The last lisp you gave me didnt have the locate file instead it was looking for teh block in teh dwg already. I tried to change out the line and I broke it. Quote
JDRBWA Posted February 5, 2009 Author Posted February 5, 2009 So the Alpha works only on the first AA I input it just gives me an A, B, C. sequence. Quote
Lee Mac Posted February 5, 2009 Posted February 5, 2009 Ah, ok, just to test it I put a single letter - so, you want the increments like: AA, BB, CC and not AA AB AC AD... Also, about the other LISP - did you modify the filepaths as necessary? Quote
Lee Mac Posted February 5, 2009 Posted February 5, 2009 OK, try this: (defun c:tagger (/ *error* vLst oVars ans pTxt sNum sNumt sTxt cnt iPt drTag bubTag drTagLst bubTagLst lAns 1pt 2pt lAng chrLst sChr sChr1 sChr2) (vl-load-com) (defun *error* (msg) (if oVars (mapcar 'setvar vLst oVars)) (if (eq "" msg) (princ "\n<< Function Complete >>") (princ (strcat "Error: " (strcase msg)))) (princ)) (setq vLst (list "OSMODE" "CLAYER" "ATTREQ" "BLIPMODE" "CMDECHO") oVars (mapcar 'getvar vLst)) (mapcar 'setvar vLst (list 0 "0" 0 0 0)) (mapcar 'makelay '("A-DOOR-IDEN" "S-GRID-IDEN" "S-GRID") '("5" "4" "2")) (if (and (tblsearch "BLOCK" "Tagdoor1") (tblsearch "BLOCK" "Grdbub01")) (progn (if (not TG:oans) (setq TG:oans "Door")) (if (not TG:olans) (setq TG:olans "Yes")) (initget "Door Bubble") (setq ans (getkword (strcat "\nSpecify Tag Type [Door/Bubble] <" TG:oans ">: "))) (if (not ans) (setq ans TG:oans) (setq TG:oans ans)) (if (and (setq pTxt (getstring t "\nSpecify Prefix Text <Enter for no Prefix>: ") sNum (getstring "\nSpecify Incremental String: ") sTxt (getstring t "\nSpecify Suffix Text <Enter for no Suffix>: "))) (progn (if (txt2num sNum) (setq sNum (txt2num sNum)) (setq sNumt (vl-string->list sNum))) (setq cnt 0) (cond ((= ans "Bubble") (initget "Yes No") (setq lAns (getkword (strcat "\nGrid-Line? [Yes/No] <" TG:olans ">: "))) (if (not lAns) (setq lAns TG:olans) (setq TG:olans lAns)) (cond ((= lAns "No") (if (and sNumt (>= (length sNumt) 2)) (progn (setq sChr1 (last sNumt) sChr2 (nth (- (length sNumt) 2) sNumt)) (while (and (setq iPt (getpoint "\nSelect Point for Symbol > ")) (< (+ sChr1 cnt) 90) (< (+ sChr2 cnt) 90)) (setvar "clayer" "S-GRID-IDEN") (command "-insert" "Grdbub01" iPt "" "" "") (setq bubTag (entnext (entlast))) (while (/= "SEQEND" (cdadr (setq bubTagLst (entget bubTag)))) (if (= "GRIDNUM" (cdr (assoc 2 bubTagLst))) (entmod (subst (cons 1 (strcat pTxt (chr (+ sChr2 cnt)) (chr (+ sChr1 cnt)) sTxt)) (assoc 1 bubTagLst) bubTagLst))) (setq bubTag (entnext bubTag))) (command "_regenall") (setq cnt (1+ cnt)))) (while (setq iPt (getpoint "\nSelect Point for Symbol > ")) (setvar "clayer" "S-GRID-IDEN") (command "-insert" "Grdbub01" iPt "" "" "") (setq bubTag (entnext (entlast))) (while (/= "SEQEND" (cdadr (setq bubTagLst (entget bubTag)))) (if (= "GRIDNUM" (cdr (assoc 2 bubTagLst))) (entmod (subst (cons 1 (strcat pTxt (rtos (+ sNum cnt) 2 0) sTxt)) (assoc 1 bubTagLst) bubTagLst))) (setq bubTag (entnext bubTag))) (command "_regenall") (setq cnt (1+ cnt))))) ((= lAns "Yes") (if (and sNumt (>= (length sNumt) 2)) (progn (setq sChr1 (last sNumt) sChr2 (nth (- (length sNumt) 2) sNumt)) (while (and (setq 1pt (getpoint "\nSpecify Grid-Line First Point > ")) (setq 2pt (getpoint 1pt "\nSpecify Second Grid-Line Point > ")) (< (+ sChr1 cnt) 90) (< (+ sChr2 cnt) 90)) (setvar "clayer" "S-GRID") (command "_line" 1pt 2pt "") (setq grLin (entlast) lAng (angle 1pt 2pt) iPt (polar 2pt lAng 0.5)) (setvar "clayer" "S-GRID-IDEN") (command "-insert" "Grdbub01" iPt "" "" "") (setq bubTag (entnext (entlast))) (while (/= "SEQEND" (cdadr (setq bubTagLst (entget bubTag)))) (if (= "GRIDNUM" (cdr (assoc 2 bubTagLst))) (entmod (subst (cons 1 (strcat pTxt (chr (+ sChr2 cnt)) (chr (+ sChr1 cnt)) sTxt)) (assoc 1 bubTagLst) bubTagLst))) (setq bubTag (entnext bubTag))) (command "_regenall") (setq cnt (1+ cnt)))) (while (and (setq 1pt (getpoint "\nSpecify Grid-Line First Point > ")) (setq 2pt (getpoint 1pt "\nSpecify Second Grid-Line Point > "))) (setvar "clayer" "S-GRID") (command "_line" 1pt 2pt "") (setq grLin (entlast) lAng (angle 1pt 2pt) iPt (polar 2pt lAng 0.5)) (setvar "clayer" "S-GRID-IDEN") (command "-insert" "Grdbub01" iPt "" "" "") (setq bubTag (entnext (entlast))) (while (/= "SEQEND" (cdadr (setq bubTagLst (entget bubTag)))) (if (= "GRIDNUM" (cdr (assoc 2 bubTagLst))) (entmod (subst (cons 1 (strcat pTxt (rtos (+ sNum cnt) 2 0) sTxt)) (assoc 1 bubTagLst) bubTagLst))) (setq bubTag (entnext bubTag))) (command "_regenall") (setq cnt (1+ cnt))))))) ((= ans "Door") (setq chrLst (vl-string->list sTxt)) (if chrLst (setq sChr (last chrLst)) (setq sChr 65)) (while (and (setq iPt (getpoint "\nSelect Point for Symbol > ")) (< (+ sChr cnt) 91)) (setvar "clayer" "A-DOOR-IDEN") (command "-insert" "Tagdoor1" iPt "" "" "") (setq drTag (entnext (entlast))) (while (/= "SEQEND" (cdadr (setq drTagLst (entget drTag)))) (if (= "DR1NUM" (cdr (assoc 2 drTagLst))) (entmod (subst (cons 1 (strcat pTxt (rtos sNum 2 0) (chr (+ sChr cnt)))) (assoc 1 drTagLst) drTagLst))) (setq drTag (entnext drTag))) (command "_regenall") (setq cnt (1+ cnt)))))))) (princ "\n<!> One or More Blocks not Found <!>")) (*error* "") (princ)) (defun makelay (x y) (if (not (tblsearch "LAYER" x)) (command "-layer" "M" x "C" y x ""))) (defun txt2num (txt / num) (or (setq num (distof txt 5)) (setq num (distof txt 2)) (setq num (distof txt 1)) (setq num (distof txt 4)) (setq num (distof txt 3)) ) (if (numberp num) num) ) If you enter AA - will increment AA BB CC etc etc If you enter AB - will increment BC CD DE etc etc I have removed the possibility of a single letter increment though. Quote
JDRBWA Posted February 5, 2009 Author Posted February 5, 2009 This worked great, I had to adjust it a little so that it brought in a linetype for s-grid. Can we make this one look at a file location instead of the block? Also in the lisp we use now we have a Dimscale preset (setq DIM (GETVAR "dimscale")) ; (setq SZ1 (* 0.5625 DIM)) ; (setq DS1 (* 0.28125 DIM)) (setq SZ1 (* 0.5 DIM)) ; Modified 09 Aug 1999 to New Office Standards (setq DS1 (* 0.25 DIM)) ; Modified 09 Aug 1999 to New Office Standards So maybe we should simplify this some. The most current lisp. Lets just say it is for grid bubbles. not doors because they are the one that would not need a AA increment but a A increment. Quote
Lee Mac Posted February 5, 2009 Posted February 5, 2009 This worked great, I had to adjust it a little so that it brought in a linetype for s-grid. Can we make this one look at a file location instead of the block? Also in the lisp we use now we have a Dimscale preset (setq DIM (GETVAR "dimscale")) ; (setq SZ1 (* 0.5625 DIM)) ; (setq DS1 (* 0.28125 DIM)) (setq SZ1 (* 0.5 DIM)) ; Modified 09 Aug 1999 to New Office Standards (setq DS1 (* 0.25 DIM)) ; Modified 09 Aug 1999 to New Office Standards So maybe we should simplify this some. The most current lisp. Lets just say it is for grid bubbles. not doors because they are the one that would not need a AA increment but a A increment. SZ1...DS1??? What are these? At the minute, the Doors increment by a single letter (in the suffix) and the Bubbles can increment by either two letters or a number. Quote
Tankman Posted March 19, 2010 Posted March 19, 2010 Interesting post! Replies are excellent. Lee Mac speaks with a lisp as always! Quote
Lee Mac Posted March 19, 2010 Posted March 19, 2010 That is quite an old LISP! I could probably write it much better... Quote
Tankman Posted March 20, 2010 Posted March 20, 2010 That is quite an old LISP! I could probably write it much better... I'm sure you can! Have never wrote a lisp but do use them. Great time savers and your work always has a bit of uniformity. One lisp I have loaded each time I open AutoCAD is Callout. The lisp has a need to be updated/upgraded. One problem would be color selection. The lisp always makes a color, magenta. Might be nice to select a color. Second up, scale, sometimes the balloon is tiny, sometimes BIG. Last, arrow is always filled. I usually use a blank arrow. Check this lisp out if you're inclined, bored, or need something to do. I'm sure your efforts would be rewarded in Heaven at least! Callout.lsp Quote
Lee Mac Posted March 20, 2010 Posted March 20, 2010 Thanks Tankman, In the meantime, I'd recommend you check out this LISP by Luis: http://www.theswamp.org/index.php?topic=17852.0 Lee Quote
Tankman Posted March 20, 2010 Posted March 20, 2010 Thanks Mr. Lisp. I tried Luis' lisp, wow! I think too much more than I might like or would use. My "stuff" is simple plan and elevation views; tanks, pipe, valves. I usually just use B3B and keep it simple. If needed, I edit the text in the bubble; i.e.: 1 edit to A. I usually just live with numbers for the nozzle schedule which we generate manually as we go. The fitting is showing two CALLOUT bubbles, one would be the norm. A or B. Simple stuff as shown on the 4" flange. Quote
Lee Mac Posted March 20, 2010 Posted March 20, 2010 Yeah, Luis' LISP is very advanced - using reactors to update the position of the callout when moved etc. But worth a look. Quote
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.