David Bethel Posted January 16, 2009 Share Posted January 16, 2009 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 Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted January 16, 2009 Share Posted January 16, 2009 Ahh, I see now. With the Polylines and LWPolylines - is the Polyline just a 3D LWPolyline? Quote Link to comment Share on other sites More sharing options...
David Bethel Posted January 16, 2009 Share Posted January 16, 2009 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 Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted January 16, 2009 Share Posted January 16, 2009 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 Quote Link to comment Share on other sites More sharing options...
ectech Posted January 20, 2009 Share Posted January 20, 2009 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 Quote Link to comment Share on other sites More sharing options...
VVA Posted January 20, 2009 Share Posted January 20, 2009 -> 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) ) Quote Link to comment Share on other sites More sharing options...
ectech Posted January 20, 2009 Share Posted January 20, 2009 thanks ! Here are the drawing file capture from screen, your lisp can select the chair one by one ? -> ectechYou 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) ) Quote Link to comment Share on other sites More sharing options...
VVA Posted January 20, 2009 Share Posted January 20, 2009 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 Quote Link to comment Share on other sites More sharing options...
bagulhodoido Posted January 21, 2009 Share Posted January 21, 2009 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. Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted January 21, 2009 Share Posted January 21, 2009 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)) Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted January 21, 2009 Share Posted January 21, 2009 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)) Quote Link to comment Share on other sites More sharing options...
bagulhodoido Posted January 21, 2009 Share Posted January 21, 2009 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? Quote Link to comment Share on other sites More sharing options...
VVA Posted January 21, 2009 Share Posted January 21, 2009 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)) Quote Link to comment Share on other sites More sharing options...
Lee Mac Posted January 21, 2009 Share Posted January 21, 2009 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. Quote Link to comment Share on other sites More sharing options...
Ashishs Posted December 13, 2017 Share Posted December 13, 2017 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 Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.