A very robust lisp

February 4, 2009

I am hoping to find some help here. I have been tasked to bite off more than I can chew.

I need a lisp routine that will give me a grid line and bubble with the numbr in it. easy enough right.

1. when the lisp starts it would be nice to ask if it is a single or multiple instance.

2. if multiple it will need to auto increment.

3. it can start at the last number inputted.

I have found an auto increment with a prefix but not suffix to it. but not sure how I would add my grid line and bubble to this.

(defun C:INN (/ ch gap hg init initstr ip p1 p2 pref tb wd)

(setq bef (getstring "\n\tEnter prefix or press Enter w/o it: "))

(setq initstr (getstring "\nEnter initial number or press Enter to default : "))

(if (eq "" initstr)(setq initstr "0001"))

(setq pref "")

(setq init (atoi initstr))

(if (eq "0" (substr initstr 1 1))

(progn

(while (eq "0" (setq ch (substr initstr 1 1)))

(setq pref (strcat pref ch))

(setq initstr (substr initstr 2)))))

(while (setq ip (getpoint "\n\tSpecify text insertion point (Enter to stop): "))

; entmake text

(entmake

(list

'(0 . "TEXT")

'(100 . "AcDbEntity")

'(100 . "AcDbText")

(cons 1 (strcat bef pref (itoa init)));string

(cons 7 "Standard");style

(cons 8 "0");layer

(cons 62 256);color

(cons 10 ip);insertion point

(cons 11 ip);alignment point

(cons 40 (getvar "dimtxt"));text height - change by suit

(cons 41 1.0);text width

(cons 50 0.0);1.5708 - vertical, 0.0 - horizontal

(cons 51 0.0);oblique angle

'(71 . 0);alignment

'(72 . 1);alignment

'(73 . 2);alignment

)

(setq tb (textbox (entget (entlast))))

(setq gap (/ (getvar "dimtxt") 4)

p1 (car tb)

p2 (cadr tb)

hg (abs (- (cadr p1)(cadr p2)))

wd (abs (- (car p1)(car p2)))

p1 (list (- (car ip) (/ wd 2) gap)(- (cadr ip) (/ hg 2) gap))

p2 (list (+ (car ip) (/ wd 2) gap)(+ (cadr ip) (/ hg 2) gap))

)

; entmake frame

(entmake

(list '(0 . "LWPOLYLINE")

'(100 . "AcDbEntity")

'(100 . "AcDbPolyline")

'(90 . 4);number of vertices

'(70 . 1);closed flag

(cons 8 "0");layer

(cons 62 2);color (256 - ByLayer)

(cons 10 p1)

(list 10 (car p2) (cadr p1))

(cons 10 p2)

(list 10 (car p1) (cadr p2))

(cons 43 0.0);polyline width

)

(setq init (1+ init))

)

(prin1)

)

(prompt "\nType INN to execute ...")

(princ)

Thanks in advance

February 4, 2009

Welcome to the forum.

Perhaps if you post a DWG with the desired grid line & bubble.

February 4, 2009

posted. I hope it helps

February 4, 2009

A really old LISP I wrote - may be of some use

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


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

 (princ "\nInitialising...")
 (defun *error*  (msg)
   (if    oldVars
     (mapcar 'setvar varLst oldVars))
   (if    (eq msg "")
     (princ "\n<< Function Complete >>")
     (princ (strcat "Error: " (strcase msg))))
   (princ))

 (setq    varLst    (list "CMDECHO" "OSMODE" "CLAYER" "DIMSCALE")
   oldVars    (mapcar 'getvar varLst))
 (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" ""))
 (initget 7)
 (if (setq dwgscal (getreal "\nType Drawing Scale: 1:"))
   (progn
     (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)
          linent  (entget tagline)
          linest  (cdr (assoc 10 linent))
          linend  (cdr (assoc 11 linent))
          tagang  (angle linest linend)
          cnt     1
          tcirc   (* dwgscal 4.2))
    (initget 7)
    (if (setq tagcnt (getint "\nSpecify Number of Tags: "))
      (progn
        (while (and (<= cnt tagcnt)
            (/= (setq tagtxt
                   (getstring (strcat "\nType Text for Tag ["
                              (rtos cnt 2 0)
                              "]: ")))
                ""))
          (setq tagtxt (strcase tagtxt))
          (setvar "clayer" "TEXT")
          (setq tcirccent (polar linend tagang (* (- (* cnt 2) 1) tcirc)))
          (setvar "osmode" 0)
          (command "_circle" tcirccent tcirc)
          (entmake
        (list '(0 . "TEXT")
              '(8 . "TEXT")
              (cons 10 tcirccent)
              (cons 40 (* dwgscal 2.5))
              (cons 1 tagtxt)
              '(50 . 0.0)
              '(7 . "STANDARD")
              '(71 . 0)
              '(72 . 1)
              '(73 . 2)
              (cons 11 tcirccent)))
          (setq cnt    (1+ cnt)
            tagtxt "")))))))
 (*error* "")
 (princ))

February 4, 2009

Lee,

I think we are close, your tag wants me to manually input each text. I am hoping to find something like the first lisp. where I could put a number or letter and it will auto increment until I say stop.

My hope is to find a lisp or help create a lisp that I can turn into a bubble grid or a door tag or window tag. let it increment everything in teh same fashion but maybe reference in a different block.

Not sure if that helps.

Thanks

Jim

February 4, 2009

To be honest Jim,

The drawing you posted is not overly clear and so I cannot make out what you require - would you be able to post a sample drawing (in 2000 format please)

February 4, 2009

So in the dwg you will see I have added to 4 different lisps -

1. is the first lisp I listed it is teh h289 text

2. is the grid bubble alone

3. is the grid bubble and line

4. is a door tag DE234A

Jim

Drawing1.dwg

February 4, 2009

Obviously three of the symbols are blocks and the fourth is not... a LISP could insert the block to the desired location and alter the attribute accordingly, but how would you like these incremented? Would a user click to each point and a new block would go there with a new number?

February 4, 2009

Yes I would like to be able to input a prefix then the number then a suffix, prefix and sufix as needed. Then just start clicking and it inserts the new block with the next number. ie.

A46B

A47B

I can post the lisp routines that make the grid bubble and line. I am guessing that the attribute in the door tag wont work which is fine. I put it in there more to show the graphics placed around it and how it is dynamic to the txt.

February 4, 2009

Try this on for size:

(defun c:tagger (/ *error* vLst oVars ans pTxt sTxt cnt iPt drTag bubTag drTagLst bubTagLst)
 (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")
   oVars (mapcar 'getvar vLst))
 (mapcar 'makelay '("A-DOOR-IDEN" "S-GRID-IDEN") '("5" "4"))
 (if (and (tblsearch "BLOCK" "Tagdoor1") (tblsearch "BLOCK" "Grdbub01"))
   (progn
 (if (not TG:oans) (setq TG:oans "Door"))
 (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>:  "))
      (not (initget 5))
      (setq sNum (getint "\nSpecify Starting Number: ")
        sTxt (getstring t "\nSpecify Suffix Text <Enter for no Suffix>:  ")))
   (progn
     (setq cnt 0)
     (mapcar 'setvar vLst (list 0 "0" 0 0))
     (while (setq iPt (getpoint "\nSelect Point for Symbol > "))
   (cond ((= ans "Door")
          (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 cnt) 2 0) sTxt))
                 (assoc 1 drTagLst) drTagLst)))
        (setq drTag (entnext drTag)))
          (command "_regenall"))
         ((= ans "Bubble")
          (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))))))           
   (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 "")))

Assumes Blocks are in Drawing initially.

February 4, 2009

I am not sure how you buy someone lunch across the pond but I better find out.

Lee, I tried it on and it is almost a custom fit. I think I will use this exact code for doors and windows, going to try and change the promt to read that way. Can we let it load the dwg template from a stored location? that way if they start fresh I dont have to preload the blocks or they get purged out by mistake.

As for the grid bubble. Could there be an option to have/not have a grid line. can we set the bubble dim factor a little different?

I will post my grid bubble lisp so you can see how we have been doing it.

Grdbub01.txt

February 4, 2009

Hi Jim,

Glad it worked OK for you

I could source the blocks from the filepath block location using the LISP - if that is what you would like?

As for the gridline - this shouldn't be a problem ~ I was hoping not to include too many "options" in the LISP as it increases its "use" time, But I can incorporate the options as necessary if needed.

Would you like the offset in there? If so, what would you like done about the block and its numbers?

February 4, 2009

ok, so as I am whipped here about this.

If we used this for a door tag could we make it so that the incremental can be a number or letter?

so for example. I have room area E234 and there are 4 doors. With the lisp right now I can say prefix starting number and then no suffix. of course the A wont work because it is not a whole number.

so I would get the result of;

DE234A

DE234B

DE234C

DE234D

February 4, 2009

Try this on for size:

(defun c:tagger     (/ *error* vLst oVars ans pTxt    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")
   oVars (mapcar 'getvar vLst))
 (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>:  "))
          (not (initget 5))
          (setq sNum (getint "\nSpecify Starting Number: ")
            sTxt (getstring t "\nSpecify Suffix Text <Enter for no Suffix>:  ")))
   (progn
     (setq cnt 0)
     (mapcar 'setvar vLst (list 0 "0" 0 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")
           (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")
           (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 "")))

For Door Tag, entered number will stay fixed, and enter a character in suffix text as a "start-character".

February 4, 2009

The line option is perfect.

I think I will try and point it to the template file instead of a block. it doesnt seem to like it unless both blocks are loaded.

February 4, 2009

I can point it to the block filepath, or leave the filepath blank for you to fill in

February 4, 2009

An updated version - silly me forgot to set the cmdecho

(defun c:tagger     (/ *error* vLst oVars ans pTxt    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>:  "))
          (not (initget 5))
          (setq sNum (getint "\nSpecify Starting Number: ")
            sTxt (getstring t "\nSpecify Suffix Text <Enter for no Suffix>:  ")))
   (progn
     (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")
           (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")
           (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 "")))

February 4, 2009

If it is indeed a filepath you would like the blocks referenced to, make sure you fill in the highlighted Parts to the correct Filepaths for each block (right down to the file level), using double backslashes.

i.e.

C:\\Users\\LeeMac\\Documents\\Block1.dwg

(defun c:tagger     (/ *error* vLst oVars DoorBlock BubbleBlock ans pTxt 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"))


 (setq    DoorBlock   "[b][color=Red]C:\\...[/color][/b]"
          BubbleBlock "[color=Red][b]C:\\...[/b][/color]")


 (if (and DoorBlock BubbleBlock)
   (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>:  "))
          (not (initget 5))
          (setq sNum (getint "\nSpecify Starting Number: ")
            sTxt (getstring t "\nSpecify Suffix Text <Enter for no Suffix>:  ")))
   (progn
     (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")
           (while (setq iPt (getpoint "\nSelect Point for Symbol > "))
             (setvar "clayer" "S-GRID-IDEN")
             (command "-insert" BubbleBlock 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")
           (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" BubbleBlock 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" DoorBlock 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 "")))

February 5, 2009

How hard is it to take the "starting number" and let it be alpha/numeric?

So that inside the grid bubbles I can have an AA, BB, CC kinda thing

February 5, 2009

So you would like the option of using incremental letters as well as numbers?

Would you still require the use of Prefixes and Suffixes?

Sign In

A very robust lisp

Recommended Posts

JDRBWA

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Posted Images

CAB

JDRBWA

Lee Mac

JDRBWA

Lee Mac

JDRBWA

Lee Mac

JDRBWA

Lee Mac

JDRBWA

Lee Mac

JDRBWA

Lee Mac

JDRBWA

Lee Mac

Lee Mac

Lee Mac

JDRBWA

Lee Mac

Join the conversation

Tutorials

Forums

Activity