object iteration by layer & linetype and fast block creation by bounding box

Anonymous · ‎03-14-2021

Hi guys,

sorry for my bad english but i am working on this plugin since a week and no way to make it work

autolisp it's not my daily programming language but loving it.

im trying to make a lsp that over a selection will take evrything into each blue bounding poly on a selected layer and make a block

and if some math guru can help me to auto setting up the insertion point could be lovely

my code :

(defun LM:boundingbox ( obj / a b lst )
    (if
        (and
            (vlax-method-applicable-p obj 'getboundingbox)
            (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'a 'b))))
            (setq lst (mapcar 'vlax-safearray->list (list a b)))
        )
        (mapcar '(lambda ( a ) (mapcar '(lambda ( b ) ((eval b) lst)) a))
           '(
                (caar   cadar)
                (caadr  cadar)
                (caadr cadadr)
                (caar  cadadr)
            )
        )
    )
)

(defun c:Print(/ selectionset insertionpoint number Blockname SS ent)
 (progn
   (if 
     (setq ss (ssget "_x" '((0 . "*POLYLINE")) '((8 . "layerprint")) ) )
     (repeat (setq i (sslength ss))	
       	(setq ent (ssname ss (setq i (1- i))))	
     	 (if 
	      (and 
		  (setq selectionset (ssget "_CP" '((LM:boundingbox (vlax-ename->vla-object ent)))))
                  (setq insertionpoint (getpoint "\n select insertion point :"))
              )
		 (setq number 1 Blockname (strcat "MyBlock" (itoa number)))
		 (while (tblsearch "BLOCK" Blockname)
                      (setq Blockname (strcat "MyBlock" (itoa (setq number (1+ number)))))
       		 )
             (command "_.-Block" Blockname insertionpoint selectionset "")
             (command "_.-insert" Blockname insertionpoint 1 1 0)
          )
          (princ)
     )
     (princ)
 )
)

ВeekeeCZ · ‎03-14-2021

See the fixed code.

Edit: with comments.

(defun c:PrintMyBlocks (/ selectionset insertionpoint number Blockname SS ent)
  ; (progn  - usless.
  (if (setq ss (ssget "_x" '((0 . "*POLYLINE") (8 . "layerprint")))) ; wrong list structure. Also, see the long comment below.
    (repeat (setq i (sslength ss))
      (setq ent (ssname ss (setq i (1- i))))
      (if (and (setq selectionset (ssget "_CP" (LM:boundingbox (vlax-ename->vla-object ent))))  ;; you already have a list from Lee's funtion. Besides, with ' you quote data as int,reals,string or lists of them. NOT variables and functions which needs to be evaluated. Then you need to usel LIST
	       (sssetfirst nil selectionset) ; hightlight them
	       (setq insertionpoint (getpoint "\n select insertion point :"))
	       )
	(progn  ;; you need to wrap 'then' of 'if'.
	  (setq number 1
		Blockname (strcat "MyBlock" (itoa number)))
	  (while (tblsearch "BLOCK" Blockname)
	    (setq Blockname (strcat "MyBlock" (itoa (setq number (1+ number)))))
	    )
	  (command "_.-Block" Blockname insertionpoint selectionset "")
	  (command "_.-insert" Blockname insertionpoint 1 1 0)
	  ))))
  (princ)
  )

If something like this is acceptable...

(defun c:PrintMyBlocks (/ selectionset insertionpoint number Blockname SS ent)
  
  (if (setq ss (ssget "_x" '((0 . "*POLYLINE") (8 . "layerprint"))))
    (repeat (setq i (sslength ss))
      (if (and (setq ent (ssname ss (setq i (1- i))))
	       (setq pnts (LM:boundingbox (vlax-ename->vla-object ent)))
	       (setq selectionset (ssget "_CP" pnts))
	       (setq insertionpoint (mapcar '/ (list (apply '+ (mapcar 'car pnts)) (apply '+ (mapcar 'cadr pnts))) (list (length pnts) (length pnts))))
	       (setq number 0)
	       (while (tblsearch "BLOCK" (setq Blockname (strcat "MyBlock" (itoa (setq number (1+ number)))))) T)
	       )
	(command "_.-Block" Blockname insertionpoint selectionset ""
		 "_.-insert" Blockname "_s" 1 "_r" 0 insertionpoint))))
  (princ)
  )

ВeekeeCZ · ‎03-14-2021

Now I am wondering how is the subject related to all the rest.

Do you want to sort some selection by layers and then by linetypes? Like

Layer1_ByLayer

Layer1_Continuous

Layer1_Dashed

Layer1_DashDot

Layer2_ByLayer

Layer2_Continuous

Layer2_Dashed

Layer2_DashDot

... and then what...

Anonymous · ‎03-14-2021

THANK YOU!!

for lisp lesson very nooby mistakes

but i have a problem with your version it look like perfect in sintax but nothing appens... no error code but no block creation... am i drunk? or maybe my cad is...

for reply to the question about the the lisp

i have need to divide a selection set of shapes on a edgelayer and transform each shape in a block with the content of the edge layer and other layers

so mi idea is

ssget all "lwpoly" on "x" layer

foreach selection create a bounding box

find center of boundingbox

create a block with ssget crossing polygon with boundingbox parameters and center as insertionpoint

ВeekeeCZ · ‎03-14-2021

This line has to be changed. It returns nil if there is no block in the drawing.

(or (while (tblsearch "BLOCK" (setq Blockname (strcat "MyBlock" (itoa (setq number (1+ number))))))) T)

ВeekeeCZ · ‎03-15-2021

Here's the example of iterations. Not sure if that's what you would like to have, so take it just as a starting point.

(vl-load-com)

(defun c:CreateBlockL+LT ( / *error* doc cmd LM:boundingbox s i e n y l p c b)
    
  (defun *error* (errmsg)
    (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break,end"))
      (princ (strcat "\nError: " errmsg)))
    (if cmd (setvar 'cmdecho 1))
    (vla-endundomark doc)
    (princ))
  
  (defun LM:boundingbox ( obj / a b lst )
    (if (and (vlax-method-applicable-p obj 'getboundingbox)
	     (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'a 'b))))
	     (setq lst (mapcar 'vlax-safearray->list (list a b))))
      (mapcar '(lambda ( a ) (mapcar '(lambda ( b ) ((eval b) lst)) a))
	      '((caar   cadar)
		(caadr  cadar)
		(caadr cadadr)
		(caar  cadadr)))))
  
  ; --------------------------
  
  (vla-startundomark (setq doc (vla-get-activedocument (vlax-get-acad-object))))
  (setq cmd (getvar 'cmdecho))
  (setvar 'cmdecho 0)
  (if (setq s (ssget))
    (repeat (setq i (sslength s))
      (setq e (ssname s (setq i (1- i)))
	    n (strcat (setq y (cdr (assoc 8 (entget e))))
		      "-"
		      (cond ((cdr (assoc 6 (entget e))))
			    ((cdr (assoc 6 (tblsearch "layer" y))))
			    ("")))
	    l (if (setq a (assoc n l))
		(subst (reverse (cons e (reverse a))) a l)
		(cons (list n e) l)))))
  (foreach n l
    (foreach e (cdr n)
      (and (setq p (LM:boundingbox (vlax-ename->vla-object e)))
	   (setq c (mapcar '/ (list (apply '+ (mapcar 'car p)) (apply '+ (mapcar 'cadr p))) (list (length p) (length p))))
	   (setq i 0)
	   (or (while (tblsearch "BLOCK" (setq b (strcat (car n) (itoa (setq i (1+ i))))))) T)
	   (command "_.-block" b "_non" c e ""
		    "_.-insert" b "_s" 1 "_r" 0 "_non" c))))
  (*error* "end")
  )

Anonymous · ‎03-18-2021

Thank you all, learning a lot form yours script, we are near now, it recognises each blockline by itself but still doesn t taking other layers content in it . Maybe i have to get a second ssget selection by cp from boundary and add others layers content to boundary object selection and then create the block ? You are really helping in my work, im workin on a large opensource advance drawing plugin, and... if someone want help Can contact me

Anonymous · ‎03-18-2021

like this

(vl-load-com)

(defun c:CreateBlockL+LT ( / *error* doc cmd LM:boundingbox s i e n y l p c b ss)
    
  (defun *error* (errmsg)
    (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break,end"))
      (princ (strcat "\nError: " errmsg)))
    (if cmd (setvar 'cmdecho 1))
    (vla-endundomark doc)
    (princ))
  
  (defun LM:boundingbox ( obj / a b lst )
    (if (and (vlax-method-applicable-p obj 'getboundingbox)
	     (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'a 'b))))
	     (setq lst (mapcar 'vlax-safearray->list (list a b))))
      (mapcar '(lambda ( a ) (mapcar '(lambda ( b ) ((eval b) lst)) a))
	      '((caar   cadar)
		(caadr  cadar)
		(caadr cadadr)
		(caar  cadadr)))))
  
  ; --------------------------
  
  (vla-startundomark (setq doc (vla-get-activedocument (vlax-get-acad-object))))
  (setq cmd (getvar 'cmdecho))
  (setvar 'cmdecho 0)
  (if (setq s (ssget "_x" '((0 . "*POLYLINE") (8 . "layer"))))
    (repeat (setq i (sslength s))
      (setq e (ssname s (setq i (1- i)))
	    n (strcat (setq y (cdr (assoc 8 (entget e))))
		      "-"
		      (cond ((cdr (assoc 6 (entget e))))
			    ((cdr (assoc 6 (tblsearch "layer" y))))
			    ("")))
	    l (if (setq a (assoc n l))
		(subst (reverse (cons e (reverse a))) a l)
		(cons (list n e) l)))))
  (foreach n l
    (foreach e (cdr n)
      (and (setq p (LM:boundingbox (vlax-ename->vla-object e)))
	   (setq c (mapcar '/ (list (apply '+ (mapcar 'car p)) (apply '+ (mapcar 'cadr p))) (list (length p) (length p))))
	   (setq i 0)
	   (setq ss (ssget "_CP" p))
	   (or (while (tblsearch "BLOCK" (setq b (strcat (car n) (itoa (setq i (1+ i))))))) T)
	   (command "_.-block" b "_non" c ss ""
		    "_.-insert" b "_s" 1 "_r" 0 "_non" c))))
  (*error* "end")
  )

Community

object iteration by layer &amp; linetype and fast block creation by bounding box