Convert to block

 

when you make the attributes using:

 [b][color=NAVY]([/color][/b]and [b][color=MAROON]([/color][/b]assoc 66 ed[b][color=MAROON])[/color][/b]
             [b][color=MAROON]([/color][/b]while [b][color=GREEN]([/color][/b]setq en [b][color=BLUE]([/color][/b]entnext en[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b]
                    [b][color=GREEN]([/color][/b]entmake [b][color=BLUE]([/color][/b]entget en[b][color=BLUE])[/color][/b][b][color=GREEN])[/color][/b][b][color=MAROON])[/color][/b][b][color=NAVY])

[/color][/b]

 

1) could this be accomplished using an IF command?

2) would this not also make the "seqend" entity? - and if so, do you need to make this?

1) Yes, you could use an (if) call. A more verbose and diligent test would be (= 1 (cdr (assoc 66 ed))) but I don't think that (66 . 0) has ever been used.

2) Yes, it creates the SEQEND entity. ( entnext ) returns nil after the SEQEND

Along with ATTRIButes it creates POLYLINE VERTEX entities. -David

Ahh, I see now.

With the Polylines and LWPolylines - is the Polyline just a 3D LWPolyline?

With the Polylines and LWPolylines - is the Polyline just a 3D LWPolyline?

No, you can still have a heavy 2D POLYLINE. 3D POLYLINEs are always heavy. Also, all of the meshes use the POLYLINE / VERTEX / SEQEND format. I believe a soon as you PEDIT -> Spline or Fit, that becomes heavy as well. -David

Ahh, Thanks David - I should've experimented first before asking the questions

I have these loaded in my start-up suite:

(defun c:en ()    (entget (car (entsel))))

(defun c:enn () (entnext (car (entsel))))

And, in fact these are the only LISPs I ever have loaded. - very handy when creating LISPs for a quick reference.

I never have any other LISPs loaded so that when I am testing LISPs I have made, no others interfere with the operation.

Thank you very much for your patience and explanations, they are much appreciated.

Cheers

Lee

Dear VVA,

Thanks ! Your lisp is very useful. Is there any method to select the entities automatically. Because I have more than 300 chairs and 200 tables inside one drawing file. If I use you lisp I need to select 500 times !!

Thanks !

Edmond

My version.

Setub - convert selected entities to unnamed block (not edit in bedit command)

Setnb - convert selected entities to named block

(defun c:setub (/ ss adoc pt_lst center blk *error*)
;;;Selected Entities To Unnamed Block
 (defun *error* (msg)
   (vla-endundomark adoc)
   (princ msg)
   (princ)
   ) ;_ end of defun
 (vl-load-com)
 (vla-startundomark
   (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
   ) ;_ end of vla-StartUndoMark
 (if (not (vl-catch-all-error-p
            (vl-catch-all-apply '(lambda () (setq ss (ssget "_:L"))))
            ) ;_ end of vl-catch-all-error-p
          ) ;_ end of not
   (progn
     (setq
       ss     (mapcar 'vlax-ename->vla-object
                      (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
                      ) ;_ end of mapcar
       pt_lst (apply 'append
                     (mapcar
                       '(lambda (x / minp maxp)
                          (vla-getboundingbox x 'minp 'maxp)
                          (list (vlax-safearray->list minp)
                                (vlax-safearray->list maxp)
                                ) ;_ end of append
                          ) ;_ end of lambda
                       ss
                       ) ;_ end of mapcar
                     ) ;_ end of append
       center (mapcar '(lambda (a b) (/ (+ a b) 2.))
                      (list (apply 'min (mapcar 'car pt_lst))
                            (apply 'min (mapcar 'cadr pt_lst))
                            (apply 'min (mapcar 'caddr pt_lst))
                            ) ;_ end of list
                      (list (apply 'max (mapcar 'car pt_lst))
                            (apply 'max (mapcar 'cadr pt_lst))
                            (apply 'max (mapcar 'caddr pt_lst))
                            ) ;_ end of list
                      ) ;_ end of mapcar
       blk    (vla-add (vla-get-blocks adoc)
                       (vlax-3d-point center)
                       "*U"
                       ) ;_ end of vla-add
       ) ;_ end of setq
     (vla-copyobjects
       adoc
       (vlax-make-variant
         (vlax-safearray-fill
           (vlax-make-safearray vlax-vbobject (cons 0 (1- (length ss))))
           ss
           ) ;_ end of vlax-safearray-fill
         ) ;_ end of vlax-make-variant
       blk
       ) ;_ end of vla-copyobjects
     (vla-insertblock
       (vla-objectidtoobject adoc (vla-get-ownerid (car ss)))
       (vlax-3d-point center)
       (vla-get-name blk)
       1.0
       1.0
       1.0
       0.0
       ) ;_ end of vla-insertblock
     (mapcar 'vla-erase ss)
     ) ;_ end of and
   ) ;_ end of if
 (vla-endundomark adoc)
 (princ)
 ) ;_ end of defun

(defun c:setnb (/ ss adoc pt_lst center blk *error* bi bname bpat)
;;;Selected Entities To Named Block
 (setq bpat "BLOCK-") ;_ <- Edit block name pattern here
 (defun *error* (msg)
   (vla-endundomark adoc)
   (princ msg)
   (princ)
   ) ;_ end of defun
 (vl-load-com)
 (vla-startundomark
   (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
   ) ;_ end of vla-StartUndoMark
 (if (not (vl-catch-all-error-p
            (vl-catch-all-apply '(lambda () (setq ss (ssget "_:L"))))
            ) ;_ end of vl-catch-all-error-p
          ) ;_ end of not
   (progn
     (setq
       ss     (mapcar 'vlax-ename->vla-object
                      (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
                      ) ;_ end of mapcar
       pt_lst (apply 'append
                     (mapcar
                       '(lambda (x / minp maxp)
                          (vla-getboundingbox x 'minp 'maxp)
                          (list (vlax-safearray->list minp)
                                (vlax-safearray->list maxp)
                                ) ;_ end of append
                          ) ;_ end of lambda
                       ss
                       ) ;_ end of mapcar
                     ) ;_ end of append
       center (mapcar '(lambda (a b) (/ (+ a b) 2.))
                      (list (apply 'min (mapcar 'car pt_lst))
                            (apply 'min (mapcar 'cadr pt_lst))
                            (apply 'min (mapcar 'caddr pt_lst))
                            ) ;_ end of list
                      (list (apply 'max (mapcar 'car pt_lst))
                            (apply 'max (mapcar 'cadr pt_lst))
                            (apply 'max (mapcar 'caddr pt_lst))
                            ) ;_ end of list
                      ) ;_ end of mapcar
       bname
       (progn
         (setq bi 0)
         (while (tblsearch "BLOCK" (setq bname (strcat bpat (itoa(setq bi(1+ bi)))))))
            bname)
       blk    (vla-add (vla-get-blocks adoc)
                       (vlax-3d-point center)
                       bname
                       ) ;_ end of vla-add
       ) ;_ end of setq
     (vla-copyobjects
       adoc
       (vlax-make-variant
         (vlax-safearray-fill
           (vlax-make-safearray vlax-vbobject (cons 0 (1- (length ss))))
           ss
           ) ;_ end of vlax-safearray-fill
         ) ;_ end of vlax-make-variant
       blk
       ) ;_ end of vla-copyobjects
     (vla-insertblock
       (vla-objectidtoobject adoc (vla-get-ownerid (car ss)))
       (vlax-3d-point center)
       (vla-get-name blk)
       1.0
       1.0
       1.0
       0.0
       ) ;_ end of vla-insertblock
     (mapcar 'vla-erase ss)
     ) ;_ end of and
   ) ;_ end of if
 (vla-endundomark adoc)
 (princ)
 ) ;_ end of defun

-> ectech

You could not publish a small example of a file.

One more variant, does the separate block of each chosen element

(defun c:setub3 (/ ss adoc pt_lst center blk *error* lst)
 (defun *error* (msg)
   (vla-endundomark adoc)
   (princ msg)
   (princ)
   ) ;_ end of defun
 (vl-load-com)
 (vla-startundomark
   (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
   ) ;_ end of vla-StartUndoMark
 (if (not (vl-catch-all-error-p
            (vl-catch-all-apply '(lambda () (setq ss (ssget "_:L"))))
            ) ;_ end of vl-catch-all-error-p
          ) ;_ end of not
   (progn
     (mapcar '(lambda(item)
     (setq
ss (list item)
       pt_lst (apply 'append
                     (mapcar
                       '(lambda (x / minp maxp)
                          (vla-getboundingbox x 'minp 'maxp)
                          (list (vlax-safearray->list minp)
                                (vlax-safearray->list maxp)
                                ) ;_ end of append
                          ) ;_ end of lambda
                       ss
                       ) ;_ end of mapcar
                     ) ;_ end of append
       center (mapcar '(lambda (a b) (/ (+ a b) 2.))
                      (list (apply 'min (mapcar 'car pt_lst))
                            (apply 'min (mapcar 'cadr pt_lst))
                            (apply 'min (mapcar 'caddr pt_lst))
                            ) ;_ end of list
                      (list (apply 'max (mapcar 'car pt_lst))
                            (apply 'max (mapcar 'cadr pt_lst))
                            (apply 'max (mapcar 'caddr pt_lst))
                            ) ;_ end of list
                      ) ;_ end of mapcar
       blk    (vla-add (vla-get-blocks adoc)
                       (vlax-3d-point center)
                       "*U"
                       ) ;_ end of vla-add
       ) ;_ end of setq
     (vla-copyobjects
       adoc
       (vlax-make-variant
         (vlax-safearray-fill
           (vlax-make-safearray vlax-vbobject (cons 0 (1- (length ss))))
           ss
           ) ;_ end of vlax-safearray-fill
         ) ;_ end of vlax-make-variant
       blk
       ) ;_ end of vla-copyobjects
     (vla-insertblock
       (vla-objectidtoobject adoc (vla-get-ownerid (car ss)))
       (vlax-3d-point center)
       (vla-get-name blk)
       1.0
       1.0
       1.0
       0.0
       ) ;_ end of vla-insertblock
	 )
  (setq
       lst     (mapcar 'vlax-ename->vla-object
                      (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
                      ) ;_ end of mapcar
)
      )
     
     (mapcar 'vla-erase lst)
     ) ;_ end of and
   ) ;_ end of if
 (vla-endundomark adoc)
 (princ)
 )

thanks ! Here are the drawing file capture from screen, your lisp can select the chair one by one ?

-> ectech

You could not publish a small example of a file.

One more variant, does the separate block of each chosen element

(defun c:setub3 (/ ss adoc pt_lst center blk *error* lst)
 (defun *error* (msg)
   (vla-endundomark adoc)
   (princ msg)
   (princ)
   ) ;_ end of defun
 (vl-load-com)
 (vla-startundomark
   (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
   ) ;_ end of vla-StartUndoMark
 (if (not (vl-catch-all-error-p
            (vl-catch-all-apply '(lambda () (setq ss (ssget "_:L"))))
            ) ;_ end of vl-catch-all-error-p
          ) ;_ end of not
   (progn
     (mapcar '(lambda(item)
     (setq
   ss (list item)
       pt_lst (apply 'append
                     (mapcar
                       '(lambda (x / minp maxp)
                          (vla-getboundingbox x 'minp 'maxp)
                          (list (vlax-safearray->list minp)
                                (vlax-safearray->list maxp)
                                ) ;_ end of append
                          ) ;_ end of lambda
                       ss
                       ) ;_ end of mapcar
                     ) ;_ end of append
       center (mapcar '(lambda (a b) (/ (+ a b) 2.))
                      (list (apply 'min (mapcar 'car pt_lst))
                            (apply 'min (mapcar 'cadr pt_lst))
                            (apply 'min (mapcar 'caddr pt_lst))
                            ) ;_ end of list
                      (list (apply 'max (mapcar 'car pt_lst))
                            (apply 'max (mapcar 'cadr pt_lst))
                            (apply 'max (mapcar 'caddr pt_lst))
                            ) ;_ end of list
                      ) ;_ end of mapcar
       blk    (vla-add (vla-get-blocks adoc)
                       (vlax-3d-point center)
                       "*U"
                       ) ;_ end of vla-add
       ) ;_ end of setq
     (vla-copyobjects
       adoc
       (vlax-make-variant
         (vlax-safearray-fill
           (vlax-make-safearray vlax-vbobject (cons 0 (1- (length ss))))
           ss
           ) ;_ end of vlax-safearray-fill
         ) ;_ end of vlax-make-variant
       blk
       ) ;_ end of vla-copyobjects
     (vla-insertblock
       (vla-objectidtoobject adoc (vla-get-ownerid (car ss)))
       (vlax-3d-point center)
       (vla-get-name blk)
       1.0
       1.0
       1.0
       0.0
       ) ;_ end of vla-insertblock
        )
     (setq
       lst     (mapcar 'vlax-ename->vla-object
                      (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
                      ) ;_ end of mapcar
   )
         )

     (mapcar 'vla-erase lst)
     ) ;_ end of and
   ) ;_ end of if
 (vla-endundomark adoc)
 (princ)
 )

If chairs are one object (3D a body) look №46.

If chairs it is pieces, arches, polylines - that yet I do not represent their algorithm of a choice

Variant of commands Setub and Setnb with inquiry of a choice of objects in a cycle.

In a choice the option:S (Allow single selection only) is included

(defun c:setub4 (/ ss adoc pt_lst center blk *error*)
;;;Selected Entities To Unnamed Block
 (defun *error* (msg)
   (vla-endundomark adoc)
   (princ msg)
   (princ)
   ) ;_ end of defun
 (vl-load-com)
 (vla-startundomark
   (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
   ) ;_ end of vla-StartUndoMark
 (princ "\nPress ESC to cancel...")
 (while (not (vl-catch-all-error-p
            (vl-catch-all-apply '(lambda ()(setq ss (ssget "_:S:L"))))
            ) ;_ end of vl-catch-all-error-p
          ) ;_ end of not
   (if ss
    (progn 
     (setq
       ss     (mapcar 'vlax-ename->vla-object
                      (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
                      ) ;_ end of mapcar
       pt_lst (apply 'append
                     (mapcar
                       '(lambda (x / minp maxp)
                          (vla-getboundingbox x 'minp 'maxp)
                          (list (vlax-safearray->list minp)
                                (vlax-safearray->list maxp)
                                ) ;_ end of append
                          ) ;_ end of lambda
                       ss
                       ) ;_ end of mapcar
                     ) ;_ end of append
       center (mapcar '(lambda (a b) (/ (+ a b) 2.))
                      (list (apply 'min (mapcar 'car pt_lst))
                            (apply 'min (mapcar 'cadr pt_lst))
                            (apply 'min (mapcar 'caddr pt_lst))
                            ) ;_ end of list
                      (list (apply 'max (mapcar 'car pt_lst))
                            (apply 'max (mapcar 'cadr pt_lst))
                            (apply 'max (mapcar 'caddr pt_lst))
                            ) ;_ end of list
                      ) ;_ end of mapcar
       blk    (vla-add (vla-get-blocks adoc)
                       (vlax-3d-point center)
                       "*U"
                       ) ;_ end of vla-add
       ) ;_ end of setq
     (vla-copyobjects
       adoc
       (vlax-make-variant
         (vlax-safearray-fill
           (vlax-make-safearray vlax-vbobject (cons 0 (1- (length ss))))
           ss
           ) ;_ end of vlax-safearray-fill
         ) ;_ end of vlax-make-variant
       blk
       ) ;_ end of vla-copyobjects
     (vla-insertblock
       (vla-objectidtoobject adoc (vla-get-ownerid (car ss)))
       (vlax-3d-point center)
       (vla-get-name blk)
       1.0
       1.0
       1.0
       0.0
       ) ;_ end of vla-insertblock
     (mapcar 'vla-erase ss)
     )
     )
   (princ "\nPress ESC to cancel...")
   )
 (vla-endundomark adoc)
 (princ)
 ) ;_ end of defun
(defun c:setnb4 (/ ss adoc pt_lst center blk *error* bi bname bpat)
;;;Selected Entities To Named Block
 (setq bpat "BLOCK-") ;_ <- Edit block name pattern here
 (defun *error* (msg)
   (vla-endundomark adoc)
   (princ msg)
   (princ)
   ) ;_ end of defun
 (vl-load-com)
 (vla-startundomark
   (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
   ) ;_ end of vla-StartUndoMark
 (princ "\nPress ESC to cancel...")
 (while (not (vl-catch-all-error-p
            (vl-catch-all-apply '(lambda () (setq ss (ssget "_:S:L"))))
            ) ;_ end of vl-catch-all-error-p
          ) ;_ end of not
   (if ss
     (progn
     (setq
       ss     (mapcar 'vlax-ename->vla-object
                      (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
                      ) ;_ end of mapcar
       pt_lst (apply 'append
                     (mapcar
                       '(lambda (x / minp maxp)
                          (vla-getboundingbox x 'minp 'maxp)
                          (list (vlax-safearray->list minp)
                                (vlax-safearray->list maxp)
                                ) ;_ end of append
                          ) ;_ end of lambda
                       ss
                       ) ;_ end of mapcar
                     ) ;_ end of append
       center (mapcar '(lambda (a b) (/ (+ a b) 2.))
                      (list (apply 'min (mapcar 'car pt_lst))
                            (apply 'min (mapcar 'cadr pt_lst))
                            (apply 'min (mapcar 'caddr pt_lst))
                            ) ;_ end of list
                      (list (apply 'max (mapcar 'car pt_lst))
                            (apply 'max (mapcar 'cadr pt_lst))
                            (apply 'max (mapcar 'caddr pt_lst))
                            ) ;_ end of list
                      ) ;_ end of mapcar
       bname
       (progn
         (setq bi 0)
         (while (tblsearch "BLOCK" (setq bname (strcat bpat (itoa(setq bi(1+ bi)))))))
            bname)
       blk    (vla-add (vla-get-blocks adoc)
                       (vlax-3d-point center)
                       bname
                       ) ;_ end of vla-add
       ) ;_ end of setq
     (vla-copyobjects
       adoc
       (vlax-make-variant
         (vlax-safearray-fill
           (vlax-make-safearray vlax-vbobject (cons 0 (1- (length ss))))
           ss
           ) ;_ end of vlax-safearray-fill
         ) ;_ end of vlax-make-variant
       blk
       ) ;_ end of vla-copyobjects
     (vla-insertblock
       (vla-objectidtoobject adoc (vla-get-ownerid (car ss)))
       (vlax-3d-point center)
       (vla-get-name blk)
       1.0
       1.0
       1.0
       0.0
       ) ;_ end of vla-insertblock
     (mapcar 'vla-erase ss)
     )
     )
   (princ "\nPress ESC to cancel...")
   ) ;_ end of if
 (vla-endundomark adoc)
 (princ)
 ) ;_ end of defun

There is indeed:

 

I worked on this with David Bethel:

 

(defun c:obj2blk1 (/ ss bn pt i ent elist)

 ; Get Entities

   (while (not ss)
   (princ "\nSelect Objects to Convert to Blocks:")
   (setq ss (ssget '((-4 . "<NOT") (0 . "INSERT,POLYLINE,VIEWPORT") (-4 . "NOT>"))))
   ) ;_  end while

 ; Get Block Name and Base Point

   (while (or (not bn)
          (not (snvalid bn))
      ) ;_  end or
   (setq bn (getstring "Specify Block Name: "))
   ) ;_  end while

   (initget 1)
   (setq pt (getpoint "Specify Base Point for Block: "))

;;; Create BLOCK Header
   (entmake (list (cons 0 "BLOCK") (cons 10 pt) (cons 2 bn) (cons 70 0)))

;;;STEP THRU THE SET
   (setq i (sslength ss))
   (while (>= i (setq i (1- i)) 0)
   (setq ent   (ssname ss i)
         elist (entget ent)
   ) ;_  end setq
   (entmake elist)
   ) ;_  end while

;;;FINISH THE BLOCK DEFINITION
   (entmake (list (cons 0 "ENDBLK") (cons 8 "0")))

;;;Insert the Block & Delete Originals
   (entmake (list (cons 0 "INSERT") (cons 2 bn) (cons 8 "0") (cons 10 pt)))
   (command "_.ERASE" ss "")
   (redraw)
   (prin1)
) ;_  end defun

Man, for some reason your lisp is adding do the block also lines from locked layers if selected. In fact, I realized most of the lisps I use the most also does, TLEN for an example, to show the total perimeter of all selected lines. I know nothing about lisp, could you show me how to avoid selecting the locked layers in the lisp commands, so I could update my lisps myself.

Not sure if this would work?

(untested)

(defun c:obj2blk1 (/ lay oLst lLst ss bn pt i ent elist)

 ; Retrieve Locked Layer List

 (setq lay (tblnext "LAYER" T))
 (while lay
   (setq oLst (cons (cdr (assoc 2 lay)) oLst)
     lay  (tblnext "LAYER")))
 (foreach x oLst
   (if    (eq 4 (logand 4 (cdr (assoc 70 (tblsearch "layer" x)))))
     (setq lLst (cons x lLst))))

 ; Get Entities

 (while (not ss)
   (princ "\nSelect Objects to Convert to Blocks:")
   (setq ss (ssget '((-4 . "<NOT") (0 . "INSERT,POLYLINE,VIEWPORT") (-4 . "NOT>")))))

 ; Get Block Name and Base Point

 (while (or (not bn)
        (not (snvalid bn)))
   (setq bn (getstring "Specify Block Name: ")))
 (initget 1)
 (setq pt (getpoint "Specify Base Point for Block: "))

;;; Create BLOCK Header

 (entmake (list (cons 0 "BLOCK") (cons 10 pt) (cons 2 bn) (cons 70 0)))

;;;STEP THRU THE SET

 (setq i (sslength ss))
 (while (>= i (setq i (1- i)) 0)
   (setq ent    (ssname ss i)
     elist    (entget ent))
   (if    (member (cdr (assoc 8 elist)) lLst)
     (ssdel ent ss)
     (entmake elist)))

;;;FINISH THE BLOCK DEFINITION

 (entmake (list (cons 0 "ENDBLK") (cons 8 "0")))

;;;Insert the Block & Delete Originals

 (entmake (list (cons 0 "INSERT") (cons 2 bn) (cons 8 "0") (cons 10 pt)))
 (command "_.ERASE" ss "")
 (redraw)
 (prin1))

An improvement:

(defun c:obj2blk1 (/ lay oLst lLst lobs ss bn pt i ent elist)

 ; Retrieve Locked Layer List

 (setq lay (tblnext "LAYER" T))
 (while lay
   (setq oLst (cons (cdr (assoc 2 lay)) oLst)
     lay  (tblnext "LAYER")))
 (foreach x oLst
   (if    (eq 4 (logand 4 (cdr (assoc 70 (tblsearch "layer" x)))))
     (setq lLst (cons x lLst))))

 ; Get Entities

 (while (not ss)
   (princ "\nSelect Objects to Convert to Blocks:")
   (setq ss (ssget '((-4 . "<NOT") (0 . "INSERT,POLYLINE,VIEWPORT") (-4 . "NOT>")))))

 ; Get Block Name and Base Point

 (while (or (not bn)
        (not (snvalid bn)))
   (setq bn (getstring "Specify Block Name: ")))
 (initget 1)
 (setq pt (getpoint "Specify Base Point for Block: "))

;;; Create BLOCK Header

 (entmake (list (cons 0 "BLOCK") (cons 10 pt) (cons 2 bn) (cons 70 0)))

;;;STEP THRU THE SET

 (setq i (sslength ss) lobs 0)
 (while (>= i (setq i (1- i)) 0)
   (setq ent    (ssname ss i)
     elist    (entget ent))
   (if    (member (cdr (assoc 8 elist)) lLst)
     (progn (ssdel ent ss) (setq lobs (1+ lobs)))
     (entmake elist)))

;;;FINISH THE BLOCK DEFINITION

 (entmake (list (cons 0 "ENDBLK") (cons 8 "0")))

;;;Insert the Block & Delete Originals

 (entmake (list (cons 0 "INSERT") (cons 2 bn) (cons 8 "0") (cons 10 pt)))
 (command "_.ERASE" ss "")
 (redraw)
 (if (not (zerop lobs)) (princ (strcat (rtos lobs) " Objects were on Locked Layers.")))
 (prin1))

An improvement:

 

(defun c:obj2blk1 (/ lay oLst lLst lobs ss bn pt i ent elist)

 ; Retrieve Locked Layer List

 (setq lay (tblnext "LAYER" T))
 (while lay
   (setq oLst (cons (cdr (assoc 2 lay)) oLst)
     lay  (tblnext "LAYER")))
 (foreach x oLst
   (if    (eq 4 (logand 4 (cdr (assoc 70 (tblsearch "layer" x)))))
     (setq lLst (cons x lLst))))

 ; Get Entities

 (while (not ss)
   (princ "\nSelect Objects to Convert to Blocks:")
   (setq ss (ssget '((-4 . "<NOT") (0 . "INSERT,POLYLINE,VIEWPORT") (-4 . "NOT>")))))

 ; Get Block Name and Base Point

 (while (or (not bn)
        (not (snvalid bn)))
   (setq bn (getstring "Specify Block Name: ")))
 (initget 1)
 (setq pt (getpoint "Specify Base Point for Block: "))

;;; Create BLOCK Header

 (entmake (list (cons 0 "BLOCK") (cons 10 pt) (cons 2 bn) (cons 70 0)))

;;;STEP THRU THE SET

 (setq i (sslength ss) lobs 0)
 (while (>= i (setq i (1- i)) 0)
   (setq ent    (ssname ss i)
     elist    (entget ent))
   (if    (member (cdr (assoc 8 elist)) lLst)
     (progn (ssdel ent ss) (setq lobs (1+ lobs)))
     (entmake elist)))

;;;FINISH THE BLOCK DEFINITION

 (entmake (list (cons 0 "ENDBLK") (cons 8 "0")))

;;;Insert the Block & Delete Originals

 (entmake (list (cons 0 "INSERT") (cons 2 bn) (cons 8 "0") (cons 10 pt)))
 (command "_.ERASE" ss "")
 (redraw)
 (if (not (zerop lobs)) (princ (strcat (rtos lobs) " Objects were on Locked Layers.")))
 (prin1))

I tested it, and the lisp still added to the block all the lines selected, even the locked ones. I might be talking bull* but I haven't seen on the rest of the lisp any IF check regarding the lay variable. Wouldn't it be needed to avoid selecting the locked lines?

The main thing has allocated red

(defun c:obj2blk2 (/ lay oLst lLst lobs ss bn pt i ent elist)

 ; Retrieve Locked Layer List

 (setq lay (tblnext "LAYER" T))
 (while lay
   (setq oLst (cons (cdr (assoc 2 lay)) oLst)
     lay  (tblnext "LAYER")))
 (foreach x oLst
   (if    (eq 4 (logand 4 (cdr (assoc 70 (tblsearch "layer" x)))))
     (setq lLst (cons x lLst))))

 ; Get Entities

 (while (not ss)
   (princ "\nSelect Objects to Convert to Blocks:")
   (setq ss (ssget [color="Red"][b][size="4"]"_:L" [/size][/b][/color]'((-4 . "<NOT") (0 . "INSERT,POLYLINE,VIEWPORT") (-4 . "NOT>")))))

 ; Get Block Name and Base Point

 (while (or (not bn)
        (not (snvalid bn)))
   (setq bn (getstring "Specify Block Name: ")))
 (initget 1)
 (setq pt (getpoint "Specify Base Point for Block: "))

;;; Create BLOCK Header

 (entmake (list (cons 0 "BLOCK") (cons 10 pt) (cons 2 bn) (cons 70 0)))

;;;STEP THRU THE SET

 (setq i (sslength ss) lobs 0)
 (while (>= i (setq i (1- i)) 0)
   (setq ent    (ssname ss i)
     elist    (entget ent))
   (if    (member (cdr (assoc 8 elist)) lLst)
     (progn (ssdel ent ss) (setq lobs (1+ lobs)))
     (entmake elist)))

;;;FINISH THE BLOCK DEFINITION

 (entmake (list (cons 0 "ENDBLK") (cons 8 "0")))

;;;Insert the Block & Delete Originals

 (entmake (list (cons 0 "INSERT") (cons 2 bn) (cons 8 "0") (cons 10 pt)))
 (command "_.ERASE" ss "")
 (redraw)
 (if (not (zerop lobs)) (princ (strcat (rtos lobs) " Objects were on Locked Layers.")))
 (prin1))

I might be talking bull* but I haven't seen on the rest of the lisp any IF check regarding the lay variable. Wouldn't it be needed to avoid selecting the locked lines?

Highlighted is the IF statement you were looking for....

(defun c:obj2blk1 (/ lay oLst lLst lobs ss bn pt i ent elist)

 ; Retrieve Locked Layer List

 (setq lay (tblnext "LAYER" T))
 (while lay
   (setq oLst (cons (cdr (assoc 2 lay)) oLst)
     lay  (tblnext "LAYER")))
 (foreach x oLst
   (if    (eq 4 (logand 4 (cdr (assoc 70 (tblsearch "layer" x)))))
     (setq lLst (cons x lLst))))

 ; Get Entities

 (while (not ss)
   (princ "\nSelect Objects to Convert to Blocks:")
   (setq ss (ssget '((-4 . "<NOT") (0 . "INSERT,POLYLINE,VIEWPORT") (-4 . "NOT>")))))

 ; Get Block Name and Base Point

 (while (or (not bn)
        (not (snvalid bn)))
   (setq bn (getstring "Specify Block Name: ")))
 (initget 1)
 (setq pt (getpoint "Specify Base Point for Block: "))

;;; Create BLOCK Header

 (entmake (list (cons 0 "BLOCK") (cons 10 pt) (cons 2 bn) (cons 70 0)))

;;;STEP THRU THE SET

 (setq i (sslength ss) lobs 0)
 (while (>= i (setq i (1- i)) 0)
   (setq ent    (ssname ss i)
     elist    (entget ent))
   [b][color=Red](if    (member (cdr (assoc 8 elist)) lLst)
     (progn (ssdel ent ss) (setq lobs (1+ lobs)))
     (entmake elist)))[/color][/b]

;;;FINISH THE BLOCK DEFINITION

 (entmake (list (cons 0 "ENDBLK") (cons 8 "0")))

;;;Insert the Block & Delete Originals

 (entmake (list (cons 0 "INSERT") (cons 2 bn) (cons 8 "0") (cons 10 pt)))
 (command "_.ERASE" ss "")
 (redraw)
 (if (not (zerop lobs)) (princ (strcat (rtos lobs) " Objects were on Locked Layers.")))
 (prin1))

But VVA, as always, I don't look for the simplest solution to a problem and try to engineer my own way to do it... Thanks for your suggestion - brilliant.

Hi,

Can above lsp be modified so that when I select multiple objects, it detects the most left-bottom corner of all the objects and paste the block without asking me any confirmation of block name and insertion point.

Thanks a lot in advance.

Regards,

Ashish

Manama, Bahrain