Inserting blocks on points

Sorry if this has been all ready been dealt with but I couldn't find anything specific when I did a search.

Using 2008 and currently getting drawings with layers that have been allocted just with points.

I would like to be able to insert a specific block (symbol) on a specific layer.

For example, layer "stop_valve" would have a symbol of a stop valve place via a lisp routine on all points on this layer and then the next layer might be "water_meter" therefore a block (symbol) of a water meter would be place on all points on this layer.

I'm assuming that wblock would be the best in this situation as all blocks could be created and store outside of the drawing.

Thanks in Advance

HenryJohn

Just to clarify - you say that the blocks will be in place of points on a certain layer?

If this is correct, it shouldn't be too difficult to accomplish.

Obviously, this kind of LISP is hard to test without being in your situation - so all the LISPs posted will probably be untested.

I would think a LISP will be provided in which the block filepaths will be left blank and also, without a drawing to know the layer structure, layer names may also have to be left blank.

But altogether - I do think it is possible.

Not my best LISP, might get you by:

(defun c:ptest (/ *error* varLst oldVars ss ssl ent elist pt index)

   ;;     --- Error Trap ---

   (defun *error* (msg)
   (mapcar 'setvar varLst oldVars)
   (if (= msg "")
       (princ (strcat "\n" (itoa index) " Blocks Inserted."))
       (princ (strcat "\n" (strcase msg)))
   ) ;_  end if
   (princ)
   ) ; end of *error*

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

   ;;     --- Error Trap ---

   (setvar "cmdecho" 0)
   (setvar "clayer" "STOP_VALVE")
   (setq ss    (ssget "X"
              (list (cons 0 "POINT")
                (cons 8 "STOP_VALVE")
                (cons 410
                  (getvar "ctab")
                ) ;_  end cons
              ) ;_  end list
       ) ;_  end ssget
     ssl    (sslength ss)
     index    0
   ) ;_  end setq
   (if    (< 0 ssl 32767)
   (progn
   (repeat    ssl
       (setq ent    (ssname ss index)
         elist    (entget ent)
         pt    (cdr (assoc 10 elist))
       ) ;_  end setq
       (command "-insert" [b][color=Red]"C:\\"[/color][/b] pt "1" "1" "0")
       (setq index (1+ index))
       (entdel ent) ; Remove this Line to keep Point
   ) ;_  end repeat
   ) ;_  end progn
   (alert "No Points Found.")
   ) ;_  end if
   (*error* "")
   (princ)
) ;_  end defun

Will work for your "stop_valve" example - change highlighted text to the block filepath.

Not sure if this would work:

(defun c:ptest (/ *error* varLst oldVars oLst ss ssl index file ent elist pt)

   ;;     --- Error Trap ---

   (defun *error* (msg)
   (mapcar 'setvar varLst oldVars)
   (if (= msg "")
       (princ (strcat "\n" (itoa index) " Blocks Inserted."))
       (princ (strcat "\n" (strcase msg)))
   ) ;_  end if
   (princ)
   ) ; end of *error*

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

   ;;     --- Error Trap ---

   (vl-load-com)
   (setvar "cmdecho" 0)

   (defun GetLayerList    ()
   (vlax-for l
           (vla-get-Layers
           (vla-get-ActiveDocument
               (vlax-get-acad-object)
           ) ;_  end vla-get-ActiveDocument
           ) ;_  end vla-get-Layers
       (setq oLst
            (cons (vla-get-Name l) oLst)
       ) ; end setq
   ) ; end vlax-for
   (reverse oLst)
   ) ; end of GetLayerList

   (foreach lay oLst
   (setq ss    (ssget "X"
              (list (cons 0 "POINT")
                (cons 8 lay)
                (cons 410 (getvar "ctab"))
              ) ;_  end list
           ) ;_  end ssget
         ssl   (sslength ss)
         index 0
   ) ;_  end setq
   (if (< 0 ssl 32767)
       (progn
       (sssetfirst nil ss)
       (initget "Yes No")
       (if (/= (getkword (strcat "\nInsert Blocks on Points on Layer " lay "? [Yes/No]: ")) "No")
           (progn
           (if (/=    (setq file (getfiled (strcat "Select a Block for Layer " lay)
                            "C:/"
                            "dwg"
                            8
                      ) ;_  end getfiled
               ) ;_  end setq
               nil
               ) ;_  end /=
               (progn
               (repeat    ssl
                   (setq ent    (ssname ss index)
                     elist    (entget ent)
                     pt    (cdr (assoc 10 elist))
                   ) ;_  end setq
                   (command "-insert" file pt "1" "1" "0")
                   (setq index (1+ index))
                   (entdel ent) ; Remove this Line to keep Point
               ) ;_  end repeat
               ) ;_  end progn
               (alert "No File Selected.")
           ) ;_  end if
           ) ;_  end progn
       ) ;_  end if
       ) ;_  end progn
       (alert "No Points Found.")
   ) ;_  end if
   ) ;_  end foreach
   (*error* "")
   (princ)
) ;_  end defun

I think that I would approach this with an associative list with each atom containing the layer name and block to insert.

[b][color=BLACK]([/color][/b]defun c:poi2ins [b][color=FUCHSIA]([/color][/b]/ bl olderr ss i en ed nd[b][color=FUCHSIA])[/color][/b]

 [b][color=FUCHSIA]([/color][/b]setq bl '[b][color=NAVY]([/color][/b][b][color=MAROON]([/color][/b]"STOP_VALVE"  . "BLOCK1"[b][color=MAROON])[/color][/b]
            [b][color=MAROON]([/color][/b]"WATER_METER" . "BLOCK2"[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]

 [b][color=FUCHSIA]([/color][/b]setq olderr *error*
       *error* [b][color=NAVY]([/color][/b]lambda [b][color=MAROON]([/color][/b]e[b][color=MAROON])[/color][/b]
                  [b][color=MAROON]([/color][/b]while [b][color=OLIVE]([/color][/b]> [b][color=BLUE]([/color][/b]getvar "CMDACTIVE"[b][color=BLUE])[/color][/b] 0[b][color=OLIVE])[/color][/b]
                         [b][color=OLIVE]([/color][/b]command[b][color=OLIVE])[/color][/b][b][color=MAROON])[/color][/b]
                  [b][color=MAROON]([/color][/b]and [b][color=OLIVE]([/color][/b]/= e "quit / exit abort"[b][color=OLIVE])[/color][/b]
                       [b][color=OLIVE]([/color][/b]princ [b][color=BLUE]([/color][/b]strcat "\nError: " e[b][color=BLUE])[/color][/b][b][color=OLIVE])[/color][/b][b][color=MAROON])[/color][/b]
                  [b][color=MAROON]([/color][/b]prin1[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]

 [b][color=FUCHSIA]([/color][/b]foreach l bl
     [b][color=NAVY]([/color][/b]cond [b][color=MAROON]([/color][/b][b][color=OLIVE]([/color][/b]not [b][color=BLUE]([/color][/b]setq ss [b][color=RED]([/color][/b]ssget "X" [b][color=PURPLE]([/color][/b]list [b][color=TEAL]([/color][/b]cons 0 "POINT"[b][color=TEAL])[/color][/b]
                                           [b][color=TEAL]([/color][/b]cons 8 [b][color=GRAY]([/color][/b]car l[b][color=GRAY])[/color][/b][b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=OLIVE])[/color][/b][b][color=MAROON])[/color][/b]
           [b][color=MAROON]([/color][/b][b][color=OLIVE]([/color][/b]tblsearch "BLOCK" [b][color=BLUE]([/color][/b]cdr l[b][color=BLUE])[/color][/b][b][color=OLIVE])[/color][/b][b][color=MAROON])[/color][/b]
           [b][color=MAROON]([/color][/b][b][color=OLIVE]([/color][/b]findfile [b][color=BLUE]([/color][/b]strcat [b][color=RED]([/color][/b]cdr l[b][color=RED])[/color][/b] ".DWG"[b][color=BLUE])[/color][/b][b][color=OLIVE])[/color][/b]
            [b][color=OLIVE]([/color][/b]command "_.INSERT" [b][color=BLUE]([/color][/b]cdr l[b][color=BLUE])[/color][/b][b][color=OLIVE])[/color][/b]
            [b][color=OLIVE]([/color][/b]command[b][color=OLIVE])[/color][/b][b][color=MAROON])[/color][/b]
           [b][color=MAROON]([/color][/b]T
            [b][color=OLIVE]([/color][/b]princ [b][color=BLUE]([/color][/b]strcat "\nBlock " [b][color=RED]([/color][/b]cdr l[b][color=RED])[/color][/b] " Not Found - "[b][color=BLUE])[/color][/b][b][color=OLIVE])[/color][/b]
            [b][color=OLIVE]([/color][/b]exit[b][color=OLIVE])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
     [b][color=NAVY]([/color][/b]setq i [b][color=MAROON]([/color][/b]sslength ss[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
     [b][color=NAVY]([/color][/b]while [b][color=MAROON]([/color][/b]not [b][color=OLIVE]([/color][/b]minusp [b][color=BLUE]([/color][/b]setq i [b][color=RED]([/color][/b]1- i[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=OLIVE])[/color][/b][b][color=MAROON])[/color][/b]
            [b][color=MAROON]([/color][/b]setq en [b][color=OLIVE]([/color][/b]ssname ss i[b][color=OLIVE])[/color][/b]
                  ed [b][color=OLIVE]([/color][/b]entget en[b][color=OLIVE])[/color][/b]
                  nd [b][color=OLIVE]([/color][/b]list [b][color=BLUE]([/color][/b]cons 2 [b][color=RED]([/color][/b]cdr l[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b]
                           [b][color=BLUE]([/color][/b]cons 0 "INSERT"[b][color=BLUE])[/color][/b][b][color=OLIVE])[/color][/b][b][color=MAROON])[/color][/b]
            [b][color=MAROON]([/color][/b]foreach g '[b][color=OLIVE]([/color][/b]6 8 10 39 48 62[b][color=OLIVE])[/color][/b]
               [b][color=OLIVE]([/color][/b]if [b][color=BLUE]([/color][/b]assoc g ed[b][color=BLUE])[/color][/b]
                   [b][color=BLUE]([/color][/b]setq nd [b][color=RED]([/color][/b]cons [b][color=PURPLE]([/color][/b]cons g [b][color=TEAL]([/color][/b]cdr [b][color=GRAY]([/color][/b]assoc g ed[b][color=GRAY])[/color][/b][b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b] nd[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=OLIVE])[/color][/b][b][color=MAROON])[/color][/b]
            [b][color=MAROON]([/color][/b]entmake [b][color=OLIVE]([/color][/b]reverse nd[b][color=OLIVE])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]

 [b][color=FUCHSIA]([/color][/b]setq *error* olderr[b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]prin1[b][color=FUCHSIA])[/color][/b][b][color=BLACK])[/color][/b]

I know some purist who do not like using (exit) or (quit), but in this instance, I believe it is correct way to inform the user that block cannot be found and therefore aborts routine. -David

David, I like the simplicity of your routine, but would this mean that the user would have to construct the associative list before proceeding with the routine?

Also, what is the purpose of the (command) on its own? (appears when you perform the insert)

Thanks for your help and advice.

Lee,

I gathered from the original post that HenryJohn was getting a lot of these types of drawings and needs to repeat the process. So 'Yes', the associative lists needs to be complete. If he were to edit the list with his standards, the routine could be used over and over without any user inputs.

As to the (command), in order to use (entmake) to create an INSERT, the block table definiton must be present. If you start the INSERT command, issue the block name and then escape out, the block table defintion is created but the INSERT itself is not.

For a robust routine, this one needs to set the sysvars THICKNESS CECOLOR CELTYPE CELTSCALE as (entmake) uses those settings for the default. Also error checking for BLOCK ATTRIButes and to insure that the BLOCK is not an existing XREF

-David

Sorry if this has been all ready been dealt with but I couldn't find anything specific when I did a search.

Using 2008 and currently getting drawings with layers that have been allocted just with points.

I would like to be able to insert a specific block (symbol) on a specific layer.

For example, layer "stop_valve" would have a symbol of a stop valve place via a lisp routine on all points on this layer and then the next layer might be "water_meter" therefore a block (symbol) of a water meter would be place on all points on this layer.

I'm assuming that wblock would be the best in this situation as all blocks could be created and store outside of the drawing.

 

Thanks in Advance

HenryJohn

Are you doing surveying drawings? Do you have a civil/survey software package?

Another question that would need answered is whether these are regular AutoCAD points or if they are survey points. If the latter what software were they created with?

Thanks for your help David - I normally (and erroneously) just automatically assume that the block is readily available for the insert command to use. - Your help is much appreciated.

As for your point Rusty - its a good one - I think we all just assumed that these "points" were just standard ACAD created points - its a good query you put forward - nice one.

Lee,

I usually use something like this to insure that a block of some kind is made.

;;;FORCE BLOCK TABLE
[b][color=BLACK]([/color][/b]defun SetBlkTF [b][color=FUCHSIA]([/color][/b]n[b][color=FUCHSIA])[/color][/b]
[b][color=FUCHSIA]([/color][/b]cond [b][color=NAVY]([/color][/b][b][color=MAROON]([/color][/b]not [b][color=GREEN]([/color][/b]snvalid n[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
       [b][color=MAROON]([/color][/b]princ [color=#2f4f4f]"\nInvalid Block Name - "[/color] n[b][color=MAROON])[/color][/b]
       [b][color=MAROON]([/color][/b]exit[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
      [b][color=NAVY]([/color][/b][b][color=MAROON]([/color][/b]tblsearch [color=#2f4f4f]"BLOCK"[/color] n[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
      [b][color=NAVY]([/color][/b][b][color=MAROON]([/color][/b]findfile [b][color=GREEN]([/color][/b]strcat n [color=#2f4f4f]".DWG"[/color][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
       [b][color=MAROON]([/color][/b]command [color=#2f4f4f]"_.INSERT"[/color] n[b][color=MAROON])[/color][/b]
       [b][color=MAROON]([/color][/b]command[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
      [b][color=NAVY]([/color][/b]T
       [b][color=MAROON]([/color][/b]entmake [b][color=GREEN]([/color][/b]list [b][color=BLUE]([/color][/b]cons 0 [color=#2f4f4f]"BLOCK"[/color][b][color=BLUE])[/color][/b][b][color=BLUE]([/color][/b]cons 2 n[b][color=BLUE])[/color][/b][b][color=BLUE]([/color][/b]cons 10 [b][color=RED]([/color][/b]list 0 0 0[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b][b][color=BLUE]([/color][/b]cons 70 0[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
       [b][color=MAROON]([/color][/b]entmake [b][color=GREEN]([/color][/b]list [b][color=BLUE]([/color][/b]cons 0 [color=#2f4f4f]"TEXT"[/color][b][color=BLUE])[/color][/b]
                      [b][color=BLUE]([/color][/b]cons 1 [b][color=RED]([/color][/b]strcat [color=#2f4f4f]"BLOCK PLACECARD - "[/color] n[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b]
                      [b][color=BLUE]([/color][/b]cons 7 [b][color=RED]([/color][/b]cdr [b][color=PURPLE]([/color][/b]assoc 2 [b][color=TEAL]([/color][/b]tblnext [color=#2f4f4f]"STYLE"[/color] T[b][color=TEAL])[/color][/b][b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b]
                      [b][color=BLUE]([/color][/b]cons 8 [color=#2f4f4f]"0"[/color][b][color=BLUE])[/color][/b]
                      [b][color=BLUE]([/color][/b]cons 10 [b][color=RED]([/color][/b]list 0 0 0[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b]
                      [b][color=BLUE]([/color][/b]cons 11 [b][color=RED]([/color][/b]list 0 0 0[b][color=RED])[/color][/b][b][color=BLUE])[/color][/b]
                      [b][color=BLUE]([/color][/b]cons 40 [b][color=RED]([/color][/b]max 1 [b][color=PURPLE]([/color][/b]getvar [color=#2f4f4f]"TEXTSIZE"[/color][b][color=PURPLE])[/color][/b][b][color=RED])[/color][/b][b][color=BLUE])[/color][/b]
                      [b][color=BLUE]([/color][/b]cons 72 4[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b]
       [b][color=MAROON]([/color][/b]entmake [b][color=GREEN]([/color][/b]list [b][color=BLUE]([/color][/b]cons 0 [color=#2f4f4f]"ENDBLK"[/color][b][color=BLUE])[/color][/b][b][color=BLUE]([/color][/b]cons 8 [color=#2f4f4f]"0"[/color][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
 n[b][color=BLACK])[/color][/b]

 [b][color=BLACK]([/color][/b]SetBlkTF [color=#2f4f4f]"TESTME"[/color][b][color=BLACK])[/color][/b]
 [b][color=BLACK]([/color][/b]entmake [b][color=FUCHSIA]([/color][/b]list [b][color=NAVY]([/color][/b]cons 0 [color=#2f4f4f]"INSERT"[/color][b][color=NAVY])[/color][/b]
                [b][color=NAVY]([/color][/b]cons 2 [color=#2f4f4f]"TESTME"[/color][b][color=NAVY])[/color][/b]
                [b][color=NAVY]([/color][/b]cons 10 [b][color=MAROON]([/color][/b]list 10 10 0[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b][b][color=BLACK])[/color][/b]

Some of (entmake)s weaknesses are that it returns nil if:

• an INSERT entity is called and the block table definition does not exist
  
• certain dxf groups are missing or corrupt

It's just not consistent as to when it crashes and errors out. -David

Thanks for the info David, I hope to learn from it.

I must admit, I try to avoid anything to do with block insertion - just because of how troublesome it can be!

I see what you have done there David. Created a block definition using the selblktf function, then invoked the block definition using the entmake. Nice codeing.

Just tested the routine - Very impressive David I must say.

But one question:

Why do you need the extra argument after the cond statement?

This is how I understand it - correct me if I am wrong

;;;FORCE BLOCK TABLE


(defun SetBlkTF    (n)
   (cond ((not (snvalid n)) ; [b][color=Red]Check the block name for dis-allowed symbols[/color][/b]
      (princ "\nInvalid Block Name - " n)
      (exit)
     )
     ((tblsearch "BLOCK" n)) ; [b][color=Red]See if the block already exists in the drawing[/color][/b]
     ((findfile (strcat n ".DWG")) ; [b][color=Red]See if the block exists in the ACAD library path[/color][/b]
      (command "_.INSERT" n) ; [b][color=Red]And if it does, create a block definition.[/color][/b]
      (command)
     )
     (T ; [b][color=Red]If all else fails....[/color][/b]
      (entmake (list (cons 0 "BLOCK") (cons 2 n) (cons 10 (list 0 0 0)) (cons 70 0))) ;[b][color=Red] Create an "artificial" block[/color][/b]
      (entmake (list (cons 0 "TEXT")
             (cons 1 (strcat "BLOCK PLACECARD - " n))
             (cons 7 (cdr (assoc 2 (tblnext "STYLE" T))))
             (cons 8 "0")
             (cons 10 (list 0 0 0))
             (cons 11 (list 0 0 0))
             (cons 40 (max 1 (getvar "TEXTSIZE"))) ; [b][color=Red]Love the "max" - great idea.[/color][/b]
             (cons 72 4)
           ) ;_  end list
      ) ;_  end entmake
      (entmake (list (cons 0 "ENDBLK") (cons 8 "0"))) ; [b][color=Red]But why two block definitions?[/color][/b]
     )
   ) ;_  end cond
   n  ;;   [b][color=Red]<<---<<< Why is this here?[/color][/b]
) ;_  end defun

(SetBlkTF "TESTME") ; [b][color=Red]Run the above[/color][/b]
(entmake (list (cons 0 "INSERT") ; [b][color=Red]entmake the block...[/color][/b]
          (cons 2 "TESTME")
          (cons 10 (list 10 10 0))
    ) ;_  end list
) ;_  end entmake

Lee,

You are a quick study !

(entmake (list (cons 0 "ENDBLK") (cons 8 "0"))) ; But why two block definitions

In order to make a BLOCK definition you must start with a (cons 0 "BLOCK") and end with a (cons 0 "ENDBLK"). One gotcha here is that if the current layer ( entmake defaults to CLAYER ) is empty during the block creation, that layer is impossible to purge later and almost impossible to track down. So I force (cons 8 "0").

) ;_ end cond

n ;;

) ;_ end defun

I use a lot ( and ) conditional testing so I make most routines end with a T value of some type, so this 1 I return the BLOCK name:

(and (SetBlkTF "TESTME_AGIAN")
    (dothis...))

It is a bit of habit, but if (SetBlkTF ) returns nil, the evaluation ceases and all stops.

(entmake (list (cons 0 "INSERT") ; entmake the block...

Remember BLOCKs and INSERTs are 2 different things.

-David

In order to make a BLOCK definition you must start with a (cons 0 "BLOCK") and end with a (cons 0 "ENDBLK"). One gotcha here is that if the current layer ( entmake defaults to CLAYER ) is empty during the block creation, that layer is impossible to purge later and almost impossible to track down. So I force (cons 8 "0").

Ahh, I understand - you sandwich the thing that you want to be a block between these two statements - sounds logical enough.

Do you have to have the DXF values in the way they are or can they be in any order? i.e. - you have the block name, insertion point and DXF 70 (not sure what this one is) at the front and only the layer name at the end - can this be varied or is the order important?

I use a lot ( and ) conditional testing so I make most routines end with a T value of some type, so this 1 I return the BLOCK name:

I like this a lot - good idea for error avoidance...

Remember BLOCKs and INSERTs are 2 different things.

How I understand it is that entmakeing an INSERT is to call a already defined block into the drawing. And to entmake a BLOCK is to define a block manually - in this case your placeholder. Am I near the mark?

Thanks once again David for your help - you are really knowledgeable in LISP. Do you use mainly Common/Basic LISP instead of Visual LISP - because I must admit, I find VL quite complicated in comparison to Common LISP. Also, how long have you worked with LISP, were you trained, or self-taught if you don't mind me asking?

David,

I tried experimenting with your ideas and made the following code:

(defun c:TB () (c:TEXTBLOCKER))

(defun c:TEXTBLOCKER (/ ent bname)
   (if
   (and
       (setq ent (car (entsel "\nSelect Text Object: ")))
       (setq bname (getstring "\nSpecify Name for Block: "))
       (snvalid bname)
       (= (cdr (assoc 0 (entget ent))) "TEXT")
   ) ;_  end and
      (progn
          (entmake
          (list
              (cons 0 "BLOCK")
              (cons 2 bname)
              (cons 10 (cdr (assoc 10 (entget ent))))
              (cons 70 0)
          ) ;_  end list
          ) ;_  end entmake
          (entmake
          (list
              (cons 0 "TEXT")
              (cons 8 (or (cdr (assoc 2 (tblsearch "LAYER" "TEXT"))) "0"))
              (cons 10 (cdr (assoc 10 (entget ent))))
              (cons 40 (max 1 (getvar "TEXTSIZE")))
              (cons 1 (cdr (assoc 1 (entget ent))))
              (cons 50 0.0)
              (cons 7 (or (cdr (assoc 2 (tblsearch "STYLE" "STANDARD"))) (cdr (assoc 2 (tblnext "STYLE" T)))))
              (cons 71 0)
              (cons 72 1)
              (cons 73 2)
              (cons 11 (cdr (assoc 10 (entget ent))))
          ) ; end list
          ) ; end entmake
          (entmake
          (list
              (cons 0 "ENDBLK")
              (cons 8 (or (cdr (assoc 2 (tblsearch "LAYER" "TEXT"))) "0"))
          ) ;_  end list
          ) ;_  end entmake
          (entdel ent)
      ) ;_  end progn
   ) ;_  end if
   (prin1)
) ;_  end defun

But I can't quite get it to function properly

Ok, David - I have sorted it.

There was a problem with my logic ...

(defun c:TB () (c:TEXTBLOCKER))

(defun c:TEXTBLOCKER (/ ent bname)
   (if
   (and
       (setq ent (car (entsel "\nSelect Text Object: ")))
       (setq bname (getstring "\nSpecify Name for Block: "))
       (snvalid bname)
       (= (cdr (assoc 0 (entget ent))) "TEXT")
   ) ;_  end and
      (progn
          (entmake
          (list
              (cons 0 "BLOCK")
              (cons 2 bname)
              (cons 10 (cdr (assoc 10 (entget ent))))
              (cons 70 0)
          ) ;_  end list
          ) ;_  end entmake
          (entmake
          (list
              (cons 0 "TEXT")
              (cons 8 "0")
              (cons 10 (cdr (assoc 10 (entget ent))))
              (cons 40 (max 1 (getvar "TEXTSIZE")))
              (cons 1 (cdr (assoc 1 (entget ent))))
              (cons 50 0.0)
              (cons 7 "STANDARD")
              (cons 71 0)
              (cons 72 1)
              (cons 73 2)
              (cons 11 (cdr (assoc 10 (entget ent))))
          ) ; end list
          ) ; end entmake
          (entmake
          (list
              (cons 0 "ENDBLK")
              (cons 8 "0")
          ) ;_  end list
          ) ;_  end entmake
          (entmake
          (list
              (cons 0 "INSERT")
              (cons 2 bname)
              (cons 10 (cdr (assoc 10 (entget ent))))
          ) ;_  end list
          ) ;_  end entmake
          (entdel ent)
      ) ;_  end progn
   ) ;_  end if
   (prin1)
) ;_  end defun

 ;(or (cdr (assoc 2 (tblsearch "LAYER" "TEXT")))

 ;(or (cdr (assoc 2 (tblsearch "STYLE")) (cdr (assoc 2 (tblnext "STYLE" T)))))

 ;(or (cdr (assoc 2 (tblsearch "LAYER" "TEXT")))

Again, thanks for all your help and advice - I have learnt bundles.

Lee,

The first thing that pops out to me is is that (or) is a boolean test that returns either T or nil.

Some suggestions:

• Allow AutoLISP to do as much parameter testing as possible. (ssget) filters are great for eliminating unwanted entity types.
  
• Keep the parameter testing altogeher - don't allow the user to continue if the input is not correct. (while) is very good for this
  
• (entmake) knows when to discard group codes that can't be reused - (-1 . ENAME) (5 . "HANDLE"). So you can use (entmake ed) the reproduce an entity
  
• ENDBLK should always use (cons 8 "0")
  
• The sample you posted really doesn't have to have the (if) or (progn) statements, only the (and) test. If any 1 statement returns nil, the process is stopped. (entmake) returns an ename if sucessful

[b][color=BLACK]([/color][/b]defun c:txt2ins [b][color=FUCHSIA]([/color][/b]/ ss bn en ed ip[b][color=FUCHSIA])[/color][/b]

[color=#8b4513];;;GET TEXT ENTITY[/color]
 [b][color=FUCHSIA]([/color][/b]while [b][color=NAVY]([/color][/b]or [b][color=MAROON]([/color][/b]not ss[b][color=MAROON])[/color][/b]
            [b][color=MAROON]([/color][/b]> [b][color=GREEN]([/color][/b]sslength ss[b][color=GREEN])[/color][/b] 1[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
        [b][color=NAVY]([/color][/b]princ [color=#2f4f4f]"\nSelect Text To Block:   "[/color][b][color=NAVY])[/color][/b]
        [b][color=NAVY]([/color][/b]setq ss [b][color=MAROON]([/color][/b]ssget '[b][color=GREEN]([/color][/b][b][color=BLUE]([/color][/b]0 . [color=#2f4f4f]"TEXT"[/color][b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]

[color=#8b4513];;;GET BLOCK NAME[/color]
 [b][color=FUCHSIA]([/color][/b]while [b][color=NAVY]([/color][/b]or [b][color=MAROON]([/color][/b]not bn[b][color=MAROON])[/color][/b]
            [b][color=MAROON]([/color][/b]not [b][color=GREEN]([/color][/b]snvalid bn[b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b]
        [b][color=NAVY]([/color][/b]setq bn [b][color=MAROON]([/color][/b]getstring [color=#2f4f4f]"\nBlock Name:   "[/color][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]

 [b][color=FUCHSIA]([/color][/b]setq en [b][color=NAVY]([/color][/b]ssname ss 0[b][color=NAVY])[/color][/b]
       ed [b][color=NAVY]([/color][/b]entget en[b][color=NAVY])[/color][/b]
       ip [b][color=NAVY]([/color][/b]cdr [b][color=MAROON]([/color][/b]assoc 10 ed[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]

[color=#8b4513];;;BUILD THE BLOCK[/color]
 [b][color=FUCHSIA]([/color][/b]entmake [b][color=NAVY]([/color][/b]list [b][color=MAROON]([/color][/b]cons 0 [color=#2f4f4f]"BLOCK"[/color][b][color=MAROON])[/color][/b][b][color=MAROON]([/color][/b]cons 10 ip[b][color=MAROON])[/color][/b]
                [b][color=MAROON]([/color][/b]cons 2 bn[b][color=MAROON])[/color][/b]
                [b][color=MAROON]([/color][/b]cons 70 0[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]entmake ed[b][color=FUCHSIA])[/color][/b]
 [b][color=FUCHSIA]([/color][/b]entmake [b][color=NAVY]([/color][/b]list [b][color=MAROON]([/color][/b]cons 0 [color=#2f4f4f]"ENDBLK"[/color][b][color=MAROON])[/color][/b][b][color=MAROON]([/color][/b]cons 8 [color=#2f4f4f]"0"[/color][b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]

[color=#8b4513];;;CREATE THE INSERT[/color]
 [b][color=FUCHSIA]([/color][/b]entmake [b][color=NAVY]([/color][/b]list [b][color=MAROON]([/color][/b]cons 0 [color=#2f4f4f]"INSERT"[/color][b][color=MAROON])[/color][/b]
                [b][color=MAROON]([/color][/b]cons 2 bn[b][color=MAROON])[/color][/b]
                [b][color=MAROON]([/color][/b]cons 8 [color=#2f4f4f]"0"[/color][b][color=MAROON])[/color][/b]
                [b][color=MAROON]([/color][/b]cons 10 ip[b][color=MAROON])[/color][/b][b][color=NAVY])[/color][/b][b][color=FUCHSIA])[/color][/b]

  [b][color=FUCHSIA]([/color][/b]entdel en[b][color=FUCHSIA])[/color][/b]
  [b][color=FUCHSIA]([/color][/b]redraw[b][color=FUCHSIA])[/color][/b]
  [b][color=FUCHSIA]([/color][/b]prin1[b][color=FUCHSIA])[/color][/b][b][color=BLACK])[/color][/b]

You are progressing very fast. Congrats! -David

Lee,

My basic AuoCAD platform is Release 12 DOS ( circa 1994 ) and it only has basic AutoLISP, no visual lisp. I agree with you that the VL functions are not very human friendly. I code in an old ASCII editor ( QEdit ) so I type, no mouse clicking anything. I use R13, R14 and A2K for testing and rendering, but R12 is a rocket on new hardware. I just never found anything that AutoDESK introduced that was a 'can't do without'. And I still hate Windows.

I do like McNeels DOSLIB extensions for file management.

I'm coming up on 20 years with AutoLISP and shouldn't admit it, but have never been to a class. In the old days Compuserve was then main forum for AutoCAD and I partisipated and learned a lot there. Once AutoDESK started it's Intermess forums, I shied away for them 'cause of the flamers and general bs over there.

I found this place a while ago and come by when time allows. It is both professional and personable.

As far as (entmake) goes, group 0 must be the first atom in the list. Other than that, I don't belive that are any other restrictions.

Regards. -David