Generate TXT of blocks that intersect another block

[codyhornyak]

How would make a LISP to make a TXT of certain blocks that intersect another block? 

I have blocks with the name SUBARRAY.  I want to know how many blocks that have a certain attribute called STRINGCOUNT. I know how to use SSGET to filter out the blocks that do not have the STRINGCOUNT attribute, but what function could I use to see which ones intersect SUBARRAY blocks.

Attached is an example dwg and an example TXT file of how the output should look. Thanks

[Moshe-A]

@codyhornyak hi,

Something is clear to me here, if you have some block references of SUBARRAY and it has attribute tag STRINGCOUNT. use SSX (or FILTER) to find all these references - problem solved 😁

more logic to me is to select all block references and only select those with STRINGCOUNT attribute - am i right?

check this:

it will return a list of enames off all the Match block references found in drawing (watch out: including those on off / freeze layers)

Moshe

(defun c:xx (/ scan-block-tag)
  
 (defun scan-block-tag (tagName / lst)
  (vlax-for AcDbBlkRef (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object)))
   (foreach AcDbAttrib (vlax-invoke AcDbBlkRef 'GetAttributes)
    (if(eq (strcase (vla-get-tagString AcDbAttrib)) (strcase tagName))
     (setq lst (cons (vlax-vla-object->ename AcDbBlkRef) lst))
    )
    (vlax-release-object AcDbAttrib)
   ); foreach
   (vlax-release-object AcDbBlkRef)
  ); vlax-for

  lst 
 ); scan-for-tag

 ; start c:xx 
 (if (ssget "_x" '((0 . "insert") (66 . 1)))
  (scan-block-tag "stringcount")
 )	    

)

[codyhornyak]

You are right that only blocks with the attribute STRINGCOUNT are needed, the rest can be filtered out. How do I know which of those blocks intersect with the blocks named SUBARRAY though?

[Moshe-A]

@codyhornyak 

check this fix

(defun c:xx (/ scan-block-tag scan-block-name)
  
 (defun scan-block-tag (tagName / lst)
  (vlax-for AcDbBlkRef (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object)))
   (foreach AcDbAttrib (vlax-invoke AcDbBlkRef 'GetAttributes)
    (if(eq (strcase (vla-get-tagString AcDbAttrib)) (strcase tagName))
     (setq lst (cons (vlax-vla-object->ename AcDbBlkRef) lst))
    )
    (vlax-release-object AcDbAttrib)
   ); foreach
   (vlax-release-object AcDbBlkRef)
  ); vlax-for

  lst 
 ); scan-for-tag

 (defun scan-block-name (bname / lst)
  (vlax-for AcDbBlkRef (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object)))
   (if (eq (strcase (vla-get-effectiveName AcDbBlkRef)) (strcase bname))
    (setq lst (cons (vlax-vla-object->ename AcDbBlkRef) lst))
   )
   (vlax-release-object AcDbBlkRef)
  ); vlax-for

  lst 
 ); scan-block-name

  
 ; start c:xx 
 (if (ssget "_x" '((0 . "insert") (66 . 1)))
  (progn
   (scan-block-tag "stringcount")

   (terpri)
   (princ (vl-list-length (scan-block-name "subarray")))
  ); progn 
 ); if

 (princ)
)

[ВeekeeCZ · Accepted solution]

You know what, you would learn a lot if you actually wrote it yourself.

(vl-load-com)

(defun c:XSubReport ( / *error* s i e o p z n j g m l a c f)
  
  (defun *error* (errmsg)
    (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break,end"))
      (princ (strcat "\nError: " errmsg)))
    (if f (close f))
    (princ))
  
  (if (setq s (ssget '((0 . "INSERT") (66 . 1))))
    (repeat (setq i (sslength s))
      (if (and (setq e (ssname s (setq i (1- i))))
	       (= "Subarray" (getpropertyvalue e "BlockTableRecord/Name"))
	       (setq o (vlax-ename->vla-object e))
	       (vlax-method-applicable-p o 'getboundingbox)
	       (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list o 'a 'b))))
	       (setq p (mapcar 'vlax-safearray->list (list a b)))
	       (setq z (ssget "_F" p '((0 . "INSERT") (66 . 1))))
	       (setq n (getpropertyvalue e "SubarrayLabel"))
	       )
	(repeat (setq j (sslength z))
	  (and (setq g (ssname z (setq j (1- j))))
	       (wcmatch (getpropertyvalue g "BlockTableRecord/Name") "~Subarray")
	       (not (vl-catch-all-error-p (setq c (vl-catch-all-apply 'getpropertyvalue (list g "STRINGCOUNT")))))
	       (setq m (if (vl-position c m) m (cons c m)))
	       (setq l (if (setq a (assoc n l))
			 (subst (cons n (if (setq b (assoc c (cdr a)))
					  (subst (cons c (1+ (cdr b)))
						 b
						 (cdr a))
					  (cons (cons c 1) (cdr a))))
				a
				l)
			 (cons (list n (cons c 1)) l))))))))

  (and l
       (setq m (vl-sort m '<))
       (setq l (mapcar '(lambda (x) (cons (car x) (mapcar '(lambda (y / a) (if (setq a (assoc y (cdr x))) (itoa (cdr a)) "0")) m)))
		       (vl-sort l '(lambda (e1 e2) (< (car e1) (car e2))))))
       (setq n (strcat (getvar 'DWGPREFIX) (vl-string-right-trim ".dwg" (getvar 'dwgname)) ".csv"))
       (setq f (open n "a"))
       (write-line (write-line (strcat "SubarrayLabel" (apply 'strcat (mapcar '(lambda (x) (strcat ",QTY OF BLOCKS WITH A STRINGCOUNT " x)) m)))) f)
       (foreach e l (write-line (write-line (substr (apply 'strcat (mapcar '(lambda (x) (strcat "," x)) e)) 2)) f))
       (close f)
       )
  
  (princ)
  )

[codyhornyak]

Thanks @ВeekeeCZ. I am learning still, just am way below your level.